github/semantic
1
1
Fork 0
mirror of https://github.com/github/semantic.git synced 2024-11-28 01:47:01 +03:00
Code Issues Projects Releases Wiki Activity

Merge branch 'master' into go-assignment

Browse Source
This commit is contained in:
Rick Winfrey 2017-10-03 09:40:18 -07:00
commit 660610a349
26 changed files with 508 additions and 275 deletions
Show Stats Download Patch File Download Diff File Expand all files Collapse all files

2
semantic-diff.cabal
View File

@ -22,6 +22,7 @@ library
, Data.Error
, Data.Functor.Both
, Data.Functor.Classes.Eq.Generic
, Data.Functor.Classes.Ord.Generic
, Data.Functor.Classes.Show.Generic
, Data.JSON.Fields
, Data.Mergeable
@ -143,6 +144,7 @@ test-suite test
main-is: Spec.hs
other-modules: AlignmentSpec
, CommandSpec
, Data.Functor.Classes.Ord.Generic.Spec
, Data.Functor.Listable
, Data.Mergeable.Spec
, Data.RandomWalkSimilarity.Spec

14
src/Data/Functor/Classes/Eq/Generic.hs
View File

@ -2,10 +2,8 @@
module Data.Functor.Classes.Eq.Generic
( Eq1(..)
, genericLiftEq
, gliftEq
) where
import Control.Comonad.Cofree as Cofree
import Data.Functor.Classes
import GHC.Generics
@ -21,18 +19,6 @@ genericLiftEq :: (Generic1 f, GEq1 (Rep1 f)) => (a -> b -> Bool) -> f a -> f b -
genericLiftEq f a b = gliftEq f (from1 a) (from1 b)
-- Eq1 instances
instance GEq1 [] where gliftEq = liftEq
instance GEq1 Maybe where gliftEq = liftEq
instance Eq a => GEq1 ((,) a) where gliftEq = liftEq
instance Eq a => GEq1 (Either a) where gliftEq = liftEq
instance Eq1 f => GEq1 (Cofree f) where
gliftEq eq = go
where go (a1 Cofree.:< f1) (a2 Cofree.:< f2) = eq a1 a2 && liftEq (gliftEq eq) f1 f2
-- Generics
instance GEq1 U1 where

51
src/Data/Functor/Classes/Ord/Generic.hs Normal file
View File

@ -0,0 +1,51 @@
{-# LANGUAGE TypeOperators #-}
module Data.Functor.Classes.Ord.Generic
( Ord1(..)
, genericLiftCompare
) where
import Data.Functor.Classes
import Data.Semigroup
import GHC.Generics
-- | Generically-derivable lifting of the 'Ord' class to unary type constructors.
class GOrd1 f where
-- | Lift a comparison function through the type constructor.
--
-- The function will usually be applied to a comparison function, but the more general type ensures that the implementation uses it to compare elements of the first container with elements of the second.
gliftCompare :: (a -> b -> Ordering) -> f a -> f b -> Ordering
-- | A suitable implementation of Ord1’s liftCompare for Generic1 types.
genericLiftCompare :: (Generic1 f, GOrd1 (Rep1 f)) => (a -> b -> Ordering) -> f a -> f b -> Ordering
genericLiftCompare f a b = gliftCompare f (from1 a) (from1 b)
-- Generics
instance GOrd1 U1 where
gliftCompare _ _ _ = EQ
instance GOrd1 Par1 where
gliftCompare f (Par1 a) (Par1 b) = f a b
instance Ord c => GOrd1 (K1 i c) where
gliftCompare _ (K1 a) (K1 b) = compare a b
instance Ord1 f => GOrd1 (Rec1 f) where
gliftCompare f (Rec1 a) (Rec1 b) = liftCompare f a b
instance GOrd1 f => GOrd1 (M1 i c f) where
gliftCompare f (M1 a) (M1 b) = gliftCompare f a b
instance (GOrd1 f, GOrd1 g) => GOrd1 (f :+: g) where
gliftCompare f a b = case (a, b) of
(L1 a, L1 b) -> gliftCompare f a b
(R1 a, R1 b) -> gliftCompare f a b
(L1 _, R1 _) -> LT
(R1 _, L1 _) -> GT
instance (GOrd1 f, GOrd1 g) => GOrd1 (f :*: g) where
gliftCompare f (a1 :*: b1) (a2 :*: b2) = gliftCompare f a1 a2 <> gliftCompare f b1 b2
instance (Ord1 f, GOrd1 g) => GOrd1 (f :.: g) where
gliftCompare f (Comp1 a) (Comp1 b) = liftCompare (gliftCompare f) a b

10
src/Data/Functor/Classes/Show/Generic.hs
View File

@ -3,8 +3,6 @@ module Data.Functor.Classes.Show.Generic
( Show1(..)
, genericLiftShowsPrec
, genericLiftShowList
, gliftShowsPrec
, gliftShowList
) where
import Data.Functor.Classes
@ -29,14 +27,6 @@ genericLiftShowList :: (Generic1 f, GShow1 (Rep1 f)) => (Int -> a -> ShowS) -> (
genericLiftShowList sp sl = gliftShowList sp sl . map from1
-- Show1 instances
instance GShow1 [] where gliftShowsPrec = liftShowsPrec
instance GShow1 Maybe where gliftShowsPrec = liftShowsPrec
instance Show a => GShow1 ((,) a) where gliftShowsPrec = liftShowsPrec
instance Show a => GShow1 (Either a) where gliftShowsPrec = liftShowsPrec
-- Generics
instance GShow1 U1 where

43
src/Data/Syntax.hs
View File

@ -8,10 +8,11 @@ import Data.Align.Generic
import Data.ByteString (ByteString)
import qualified Data.Error as Error
import Data.Foldable (asum, toList)
import Data.Function ((&))
import Data.Function ((&), on)
import Data.Ix
import Data.List.NonEmpty (NonEmpty(..), nonEmpty)
import Data.Functor.Classes.Eq.Generic
import Data.Functor.Classes.Ord.Generic
import Data.Functor.Classes.Show.Generic
import Data.Mergeable
import Data.Record
@ -53,7 +54,7 @@ handleError = flip catchError (\ err -> makeTerm <$> Assignment.location <*> pur
-- | Catch parse errors into an error term.
parseError :: (HasCallStack, Error :< fs, Bounded grammar, Enum grammar, Ix grammar, Apply Foldable fs) => Assignment.Assignment ast grammar (Term (Union fs) (Record Assignment.Location))
parseError = makeTerm <$> Assignment.token maxBound <*> pure (Error (getCallStack (freezeCallStack callStack)) [] (Just "ParseError") [])
parseError = makeTerm <$> Assignment.token maxBound <*> pure (Error (ErrorStack (getCallStack (freezeCallStack callStack))) [] (Just "ParseError") [])
-- | Match context terms before a subject term, wrapping both up in a Context term if any context terms matched, or otherwise returning the subject term.
@ -101,22 +102,25 @@ infixContext context left right operators = uncurry (&) <$> postContextualizeThr
-- | An identifier of some other construct, whether a containing declaration (e.g. a class name) or a reference (e.g. a variable).
newtype Identifier a = Identifier ByteString
deriving (Diffable, Eq, Foldable, Functor, GAlign, Generic1, Mergeable, Show, Traversable)
deriving (Diffable, Eq, Foldable, Functor, GAlign, Generic1, Mergeable, Ord, Show, Traversable)
instance Eq1 Identifier where liftEq = genericLiftEq
instance Ord1 Identifier where liftCompare = genericLiftCompare
instance Show1 Identifier where liftShowsPrec = genericLiftShowsPrec
newtype Program a = Program [a]
deriving (Diffable, Eq, Foldable, Functor, GAlign, Generic1, Mergeable, Show, Traversable)
deriving (Diffable, Eq, Foldable, Functor, GAlign, Generic1, Mergeable, Ord, Show, Traversable)
instance Eq1 Program where liftEq = genericLiftEq
instance Ord1 Program where liftCompare = genericLiftCompare
instance Show1 Program where liftShowsPrec = genericLiftShowsPrec
-- | An accessibility modifier, e.g. private, public, protected, etc.
newtype AccessibilityModifier a = AccessibilityModifier ByteString
deriving (Diffable, Eq, Foldable, Functor, GAlign, Generic1, Show, Traversable)
deriving (Diffable, Eq, Foldable, Functor, GAlign, Generic1, Mergeable, Ord, Show, Traversable)
instance Eq1 AccessibilityModifier where liftEq = genericLiftEq
instance Ord1 AccessibilityModifier where liftCompare = genericLiftCompare
instance Show1 AccessibilityModifier where liftShowsPrec = genericLiftShowsPrec
@ -124,31 +128,48 @@ instance Show1 AccessibilityModifier where liftShowsPrec = genericLiftShowsPrec
--
-- This can be used to represent an implicit no-op, e.g. the alternative in an 'if' statement without an 'else'.
data Empty a = Empty
deriving (Diffable, Eq, Foldable, Functor, GAlign, Generic1, Mergeable, Show, Traversable)
deriving (Diffable, Eq, Foldable, Functor, GAlign, Generic1, Mergeable, Ord, Show, Traversable)
instance Eq1 Empty where liftEq _ _ _ = True
instance Show1 Empty where liftShowsPrec _ _ _ _ = showString "Empty"
-- | Syntax representing a parsing or assignment error.
data Error a = Error { errorCallStack :: [([Char], SrcLoc)], errorExpected :: [String], errorActual :: Maybe String, errorChildren :: [a] }
deriving (Diffable, Eq, Foldable, Functor, GAlign, Generic1, Mergeable, Show, Traversable)
data Error a = Error { errorCallStack :: ErrorStack, errorExpected :: [String], errorActual :: Maybe String, errorChildren :: [a] }
deriving (Diffable, Eq, Foldable, Functor, GAlign, Generic1, Mergeable, Ord, Show, Traversable)
instance Eq1 Error where liftEq = genericLiftEq
instance Ord1 Error where liftCompare = genericLiftCompare
instance Show1 Error where liftShowsPrec = genericLiftShowsPrec
errorSyntax :: Error.Error String -> [a] -> Error a
errorSyntax Error.Error{..} = Error (getCallStack callStack) errorExpected errorActual
errorSyntax Error.Error{..} = Error (ErrorStack (getCallStack callStack)) errorExpected errorActual
unError :: Span -> Error a -> Error.Error String
unError span Error{..} = Error.withCallStack (freezeCallStack (fromCallSiteList errorCallStack)) (Error.Error span errorExpected errorActual)
unError span Error{..} = Error.withCallStack (freezeCallStack (fromCallSiteList (unErrorStack errorCallStack))) (Error.Error span errorExpected errorActual)
newtype ErrorStack = ErrorStack { unErrorStack :: [(String, SrcLoc)] }
deriving (Eq, Show)
instance Ord ErrorStack where
compare = liftCompare (liftCompare compareSrcLoc) `on` unErrorStack
where compareSrcLoc s1 s2 = mconcat
[ (compare `on` srcLocPackage) s1 s2
, (compare `on` srcLocModule) s1 s2
, (compare `on` srcLocFile) s1 s2
, (compare `on` srcLocStartLine) s1 s2
, (compare `on` srcLocStartCol) s1 s2
, (compare `on` srcLocEndLine) s1 s2
, (compare `on` srcLocEndCol) s1 s2
]
data Context a = Context { contextTerms :: NonEmpty a, contextSubject :: a }
deriving (Eq, Foldable, Functor, GAlign, Generic1, Mergeable, Show, Traversable)
deriving (Eq, Foldable, Functor, GAlign, Generic1, Mergeable, Ord, Show, Traversable)
instance Diffable Context where
subalgorithmFor blur focus (Context n1 s1) = Context <$> traverse blur n1 <*> focus s1
instance Eq1 Context where liftEq = genericLiftEq
instance Ord1 Context where liftCompare = genericLiftCompare
instance Show1 Context where liftShowsPrec = genericLiftShowsPrec

37
src/Data/Syntax/Declaration.hs
View File

@ -4,57 +4,65 @@ module Data.Syntax.Declaration where
import Algorithm
import Data.Align.Generic
import Data.Functor.Classes.Eq.Generic
import Data.Functor.Classes.Ord.Generic
import Data.Functor.Classes.Show.Generic
import Data.Mergeable
import GHC.Generics
data Function a = Function { functionContext :: ![a], functionName :: !a, functionParameters :: ![a], functionBody :: !a }
deriving (Diffable, Eq, Foldable, Functor, GAlign, Generic1, Mergeable, Show, Traversable)
deriving (Diffable, Eq, Foldable, Functor, GAlign, Generic1, Mergeable, Ord, Show, Traversable)
instance Eq1 Function where liftEq = genericLiftEq
instance Ord1 Function where liftCompare = genericLiftCompare
instance Show1 Function where liftShowsPrec = genericLiftShowsPrec
-- TODO: How should we represent function types, where applicable?
data Method a = Method { methodContext :: ![a], methodReceiver :: !a, methodName :: !a, methodParameters :: ![a], methodBody :: !a }
deriving (Diffable, Eq, Foldable, Functor, GAlign, Generic1, Mergeable, Show, Traversable)
deriving (Diffable, Eq, Foldable, Functor, GAlign, Generic1, Mergeable, Ord, Show, Traversable)
instance Eq1 Method where liftEq = genericLiftEq
instance Ord1 Method where liftCompare = genericLiftCompare
instance Show1 Method where liftShowsPrec = genericLiftShowsPrec
data RequiredParameter a = RequiredParameter { requiredParameter :: !a }
deriving (Diffable, Eq, Foldable, Functor, GAlign, Generic1, Show, Traversable)
deriving (Diffable, Eq, Foldable, Functor, GAlign, Generic1, Mergeable, Ord, Show, Traversable)
instance Eq1 RequiredParameter where liftEq = genericLiftEq
instance Ord1 RequiredParameter where liftCompare = genericLiftCompare
instance Show1 RequiredParameter where liftShowsPrec = genericLiftShowsPrec
data OptionalParameter a = OptionalParameter { optionalParameter :: !a }
deriving (Diffable, Eq, Foldable, Functor, GAlign, Generic1, Show, Traversable)
deriving (Diffable, Eq, Foldable, Functor, GAlign, Generic1, Mergeable, Ord, Show, Traversable)
instance Eq1 OptionalParameter where liftEq = genericLiftEq
instance Ord1 OptionalParameter where liftCompare = genericLiftCompare
instance Show1 OptionalParameter where liftShowsPrec = genericLiftShowsPrec
-- TODO: Should we replace this with Function and differentiate by context?
-- TODO: How should we distinguish class/instance methods?
data Variable a = Variable { variableName :: !a, variableType :: !a, variableValue :: !a }
deriving (Diffable, Eq, Foldable, Functor, GAlign, Generic1, Mergeable, Show, Traversable)
deriving (Diffable, Eq, Foldable, Functor, GAlign, Generic1, Mergeable, Ord, Show, Traversable)
instance Eq1 Variable where liftEq = genericLiftEq
instance Ord1 Variable where liftCompare = genericLiftCompare
instance Show1 Variable where liftShowsPrec = genericLiftShowsPrec
data Class a = Class { classContext :: ![a], classIdentifier :: !a, classSuperclasses :: ![a], classBody :: ![a] }
deriving (Diffable, Eq, Foldable, Functor, GAlign, Generic1, Mergeable, Show, Traversable)
deriving (Diffable, Eq, Foldable, Functor, GAlign, Generic1, Mergeable, Ord, Show, Traversable)
instance Eq1 Class where liftEq = genericLiftEq
instance Ord1 Class where liftCompare = genericLiftCompare
instance Show1 Class where liftShowsPrec = genericLiftShowsPrec
data Module a = Module { moduleIdentifier :: !a, moduleScope :: ![a] }
deriving (Diffable, Eq, Foldable, Functor, GAlign, Generic1, Mergeable, Show, Traversable)
deriving (Diffable, Eq, Foldable, Functor, GAlign, Generic1, Mergeable, Ord, Show, Traversable)
instance Eq1 Module where liftEq = genericLiftEq
instance Ord1 Module where liftCompare = genericLiftCompare
instance Show1 Module where liftShowsPrec = genericLiftShowsPrec
data Interface a = Interface { interfaceIdentifier :: !a, interfaceBody :: ![a] }
@ -65,9 +73,10 @@ instance Show1 Interface where liftShowsPrec = genericLiftShowsPrec
-- | A decorator in Python
data Decorator a = Decorator { decoratorIdentifier :: !a, decoratorParamaters :: ![a], decoratorBody :: !a }
deriving (Diffable, Eq, Foldable, Functor, GAlign, Generic1, Mergeable, Show, Traversable)
deriving (Diffable, Eq, Foldable, Functor, GAlign, Generic1, Mergeable, Ord, Show, Traversable)
instance Eq1 Decorator where liftEq = genericLiftEq
instance Ord1 Decorator where liftCompare = genericLiftCompare
instance Show1 Decorator where liftShowsPrec = genericLiftShowsPrec
-- TODO: Generics, constraints.
@ -75,30 +84,34 @@ instance Show1 Decorator where liftShowsPrec = genericLiftShowsPrec
-- | An ADT, i.e. a disjoint sum of products, like 'data' in Haskell, or 'enum' in Rust or Swift.
data Datatype a = Datatype { datatypeName :: !a, datatypeConstructors :: ![a] }
deriving (Diffable, Eq, Foldable, Functor, GAlign, Generic1, Mergeable, Show, Traversable)
deriving (Diffable, Eq, Foldable, Functor, GAlign, Generic1, Mergeable, Ord, Show, Traversable)
instance Eq1 Data.Syntax.Declaration.Datatype where liftEq = genericLiftEq
instance Ord1 Data.Syntax.Declaration.Datatype where liftCompare = genericLiftCompare
instance Show1 Data.Syntax.Declaration.Datatype where liftShowsPrec = genericLiftShowsPrec
-- | A single constructor in a datatype, or equally a 'struct' in C, Rust, or Swift.
data Constructor a = Constructor { constructorName :: !a, constructorFields :: ![a] }
deriving (Diffable, Eq, Foldable, Functor, GAlign, Generic1, Mergeable, Show, Traversable)
deriving (Diffable, Eq, Foldable, Functor, GAlign, Generic1, Mergeable, Ord, Show, Traversable)
instance Eq1 Data.Syntax.Declaration.Constructor where liftEq = genericLiftEq
instance Ord1 Data.Syntax.Declaration.Constructor where liftCompare = genericLiftCompare
instance Show1 Data.Syntax.Declaration.Constructor where liftShowsPrec = genericLiftShowsPrec
-- | Comprehension (e.g. ((a for b in c if a()) in Python)
data Comprehension a = Comprehension { comprehensionValue :: !a, comprehensionBody :: !a }
deriving (Diffable, Eq, Foldable, Functor, GAlign, Generic1, Mergeable, Show, Traversable)
deriving (Diffable, Eq, Foldable, Functor, GAlign, Generic1, Mergeable, Ord, Show, Traversable)
instance Eq1 Comprehension where liftEq = genericLiftEq
instance Ord1 Comprehension where liftCompare = genericLiftCompare
instance Show1 Comprehension where liftShowsPrec = genericLiftShowsPrec
-- | Import declarations.
data Import a = Import { importContent :: ![a] }
deriving (Diffable, Eq, Foldable, Functor, GAlign, Generic1, Mergeable, Show, Traversable)
deriving (Diffable, Eq, Foldable, Functor, GAlign, Generic1, Mergeable, Ord, Show, Traversable)
instance Eq1 Import where liftEq = genericLiftEq
instance Ord1 Import where liftCompare = genericLiftCompare
instance Show1 Import where liftShowsPrec = genericLiftShowsPrec

40
src/Data/Syntax/Expression.hs
View File

@ -4,15 +4,17 @@ module Data.Syntax.Expression where
import Algorithm
import Data.Align.Generic
import Data.Functor.Classes.Eq.Generic
import Data.Functor.Classes.Ord.Generic
import Data.Functor.Classes.Show.Generic
import Data.Mergeable
import GHC.Generics
-- | Typical prefix function application, like `f(x)` in many languages, or `f x` in Haskell.
data Call a = Call { callContext :: ![a], callFunction :: !a, callParams :: ![a], callBlock :: !a }
deriving (Diffable, Eq, Foldable, Functor, GAlign, Generic1, Mergeable, Show, Traversable)
deriving (Diffable, Eq, Foldable, Functor, GAlign, Generic1, Mergeable, Ord, Show, Traversable)
instance Eq1 Call where liftEq = genericLiftEq
instance Ord1 Call where liftCompare = genericLiftCompare
instance Show1 Call where liftShowsPrec = genericLiftShowsPrec
@ -23,9 +25,10 @@ data Comparison a
| GreaterThanEqual !a !a
| Equal !a !a
| Comparison !a !a
deriving (Diffable, Eq, Foldable, Functor, GAlign, Generic1, Mergeable, Show, Traversable)
deriving (Diffable, Eq, Foldable, Functor, GAlign, Generic1, Mergeable, Ord, Show, Traversable)
instance Eq1 Comparison where liftEq = genericLiftEq
instance Ord1 Comparison where liftCompare = genericLiftCompare
instance Show1 Comparison where liftShowsPrec = genericLiftShowsPrec
@ -38,9 +41,10 @@ data Arithmetic a
| Modulo !a !a
| Power !a !a
| Negate !a
deriving (Diffable, Eq, Foldable, Functor, GAlign, Generic1, Mergeable, Show, Traversable)
deriving (Diffable, Eq, Foldable, Functor, GAlign, Generic1, Mergeable, Ord, Show, Traversable)
instance Eq1 Arithmetic where liftEq = genericLiftEq
instance Ord1 Arithmetic where liftCompare = genericLiftCompare
instance Show1 Arithmetic where liftShowsPrec = genericLiftShowsPrec
-- | Boolean operators.
@ -48,30 +52,34 @@ data Boolean a
= Or !a !a
| And !a !a
| Not !a
deriving (Diffable, Eq, Foldable, Functor, GAlign, Generic1, Mergeable, Show, Traversable)
deriving (Diffable, Eq, Foldable, Functor, GAlign, Generic1, Mergeable, Ord, Show, Traversable)
instance Eq1 Boolean where liftEq = genericLiftEq
instance Ord1 Boolean where liftCompare = genericLiftCompare
instance Show1 Boolean where liftShowsPrec = genericLiftShowsPrec
-- | Javascript delete operator
newtype Delete a = Delete a
deriving (Diffable, Eq, Foldable, Functor, GAlign, Generic1, Show, Traversable)
deriving (Diffable, Eq, Foldable, Functor, GAlign, Generic1, Mergeable, Ord, Show, Traversable)
instance Eq1 Delete where liftEq = genericLiftEq
instance Ord1 Delete where liftCompare = genericLiftCompare
instance Show1 Delete where liftShowsPrec = genericLiftShowsPrec
-- | Javascript void operator
newtype Void a = Void a
deriving (Diffable, Eq, Foldable, Functor, GAlign, Generic1, Show, Traversable)
deriving (Diffable, Eq, Foldable, Functor, GAlign, Generic1, Mergeable, Ord, Show, Traversable)
instance Eq1 Void where liftEq = genericLiftEq
instance Ord1 Void where liftCompare = genericLiftCompare
instance Show1 Void where liftShowsPrec = genericLiftShowsPrec
-- | Javascript typeof operator
newtype Typeof a = Typeof a
deriving (Diffable, Eq, Foldable, Functor, GAlign, Generic1, Show, Traversable)
deriving (Diffable, Eq, Foldable, Functor, GAlign, Generic1, Mergeable, Ord, Show, Traversable)
instance Eq1 Typeof where liftEq = genericLiftEq
instance Ord1 Typeof where liftCompare = genericLiftCompare
instance Show1 Typeof where liftShowsPrec = genericLiftShowsPrec
-- | Bitwise operators.
@ -82,46 +90,52 @@ data Bitwise a
| LShift !a !a
| RShift !a !a
| Complement a
deriving (Diffable, Eq, Foldable, Functor, GAlign, Generic1, Mergeable, Show, Traversable)
deriving (Diffable, Eq, Foldable, Functor, GAlign, Generic1, Mergeable, Ord, Show, Traversable)
instance Eq1 Bitwise where liftEq = genericLiftEq
instance Ord1 Bitwise where liftCompare = genericLiftCompare
instance Show1 Bitwise where liftShowsPrec = genericLiftShowsPrec
-- | Member Access (e.g. a.b)
data MemberAccess a
= MemberAccess !a !a
deriving (Diffable, Eq, Foldable, Functor, GAlign, Generic1, Mergeable, Show, Traversable)
deriving (Diffable, Eq, Foldable, Functor, GAlign, Generic1, Mergeable, Ord, Show, Traversable)
instance Eq1 MemberAccess where liftEq = genericLiftEq
instance Ord1 MemberAccess where liftCompare = genericLiftCompare
instance Show1 MemberAccess where liftShowsPrec = genericLiftShowsPrec
-- | Subscript (e.g a[1])
data Subscript a
= Subscript !a ![a]
| Member !a !a
deriving (Diffable, Eq, Foldable, Functor, GAlign, Generic1, Mergeable, Show, Traversable)
deriving (Diffable, Eq, Foldable, Functor, GAlign, Generic1, Mergeable, Ord, Show, Traversable)
instance Eq1 Subscript where liftEq = genericLiftEq
instance Ord1 Subscript where liftCompare = genericLiftCompare
instance Show1 Subscript where liftShowsPrec = genericLiftShowsPrec
-- | Enumeration (e.g. a[1:10:1] in Python (start at index 1, stop at index 10, step 1 element from start to stop))
data Enumeration a = Enumeration { enumerationStart :: !a, enumerationEnd :: !a, enumerationStep :: !a }
deriving (Diffable, Eq, Foldable, Functor, GAlign, Generic1, Mergeable, Show, Traversable)
deriving (Diffable, Eq, Foldable, Functor, GAlign, Generic1, Mergeable, Ord, Show, Traversable)
instance Eq1 Enumeration where liftEq = genericLiftEq
instance Ord1 Enumeration where liftCompare = genericLiftCompare
instance Show1 Enumeration where liftShowsPrec = genericLiftShowsPrec
-- | InstanceOf (e.g. a instanceof b in JavaScript
data InstanceOf a = InstanceOf { instanceOfSubject :: !a, instanceOfObject :: !a }
deriving (Diffable, Eq, Foldable, Functor, GAlign, Generic1, Show, Traversable)
deriving (Diffable, Eq, Foldable, Functor, GAlign, Generic1, Mergeable, Ord, Show, Traversable)
instance Eq1 InstanceOf where liftEq = genericLiftEq
instance Ord1 InstanceOf where liftCompare = genericLiftCompare
instance Show1 InstanceOf where liftShowsPrec = genericLiftShowsPrec
-- | ScopeResolution (e.g. import a.b in Python or a::b in C++)
data ScopeResolution a
= ScopeResolution ![a]
deriving (Diffable, Eq, Foldable, Functor, GAlign, Generic1, Mergeable, Show, Traversable)
deriving (Diffable, Eq, Foldable, Functor, GAlign, Generic1, Mergeable, Ord, Show, Traversable)
instance Eq1 ScopeResolution where liftEq = genericLiftEq
instance Ord1 ScopeResolution where liftCompare = genericLiftCompare
instance Show1 ScopeResolution where liftShowsPrec = genericLiftShowsPrec

47
src/Data/Syntax/Literal.hs
View File

@ -5,14 +5,16 @@ import Algorithm
import Data.Align.Generic
import Data.ByteString (ByteString)
import Data.Functor.Classes.Eq.Generic
import Data.Functor.Classes.Ord.Generic
import Data.Functor.Classes.Show.Generic
import Data.Mergeable
import GHC.Generics
import Prelude
-- Boolean
newtype Boolean a = Boolean Bool
deriving (Diffable, Eq, Foldable, Functor, GAlign, Generic1, Show, Traversable)
deriving (Diffable, Eq, Foldable, Functor, GAlign, Generic1, Mergeable, Ord, Show, Traversable)
true :: Boolean a
true = Boolean True
@ -21,6 +23,7 @@ false :: Boolean a
false = Boolean False
instance Eq1 Boolean where liftEq = genericLiftEq
instance Ord1 Boolean where liftCompare = genericLiftCompare
instance Show1 Boolean where liftShowsPrec = genericLiftShowsPrec
@ -28,9 +31,10 @@ instance Show1 Boolean where liftShowsPrec = genericLiftShowsPrec
-- | A literal integer of unspecified width. No particular base is implied.
newtype Integer a = Integer { integerContent :: ByteString }
deriving (Diffable, Eq, Foldable, Functor, GAlign, Generic1, Show, Traversable)
deriving (Diffable, Eq, Foldable, Functor, GAlign, Generic1, Mergeable, Ord, Show, Traversable)
instance Eq1 Data.Syntax.Literal.Integer where liftEq = genericLiftEq
instance Ord1 Data.Syntax.Literal.Integer where liftCompare = genericLiftCompare
instance Show1 Data.Syntax.Literal.Integer where liftShowsPrec = genericLiftShowsPrec
-- TODO: Should IntegerLiteral hold an Integer instead of a ByteString?
@ -39,67 +43,74 @@ instance Show1 Data.Syntax.Literal.Integer where liftShowsPrec = genericLiftShow
-- | A literal float of unspecified width.
newtype Float a = Float { floatContent :: ByteString }
deriving (Diffable, Eq, Foldable, Functor, GAlign, Generic1, Show, Traversable)
deriving (Diffable, Eq, Foldable, Functor, GAlign, Generic1, Mergeable, Ord, Show, Traversable)
instance Eq1 Data.Syntax.Literal.Float where liftEq = genericLiftEq
instance Show1 Data.Syntax.Literal.Float where liftShowsPrec = genericLiftShowsPrec
-- Rational literals e.g. `2/3r`
newtype Rational a = Rational ByteString
deriving (Diffable, Eq, Foldable, Functor, GAlign, Generic1, Show, Traversable)
deriving (Diffable, Eq, Foldable, Functor, GAlign, Generic1, Mergeable, Ord, Show, Traversable)
instance Eq1 Data.Syntax.Literal.Rational where liftEq = genericLiftEq
instance Ord1 Data.Syntax.Literal.Rational where liftCompare = genericLiftCompare
instance Show1 Data.Syntax.Literal.Rational where liftShowsPrec = genericLiftShowsPrec
-- Complex literals e.g. `3 + 2i`
newtype Complex a = Complex ByteString
deriving (Diffable, Eq, Foldable, Functor, GAlign, Generic1, Show, Traversable)
deriving (Diffable, Eq, Foldable, Functor, GAlign, Generic1, Mergeable, Ord, Show, Traversable)
instance Eq1 Data.Syntax.Literal.Complex where liftEq = genericLiftEq
instance Ord1 Data.Syntax.Literal.Complex where liftCompare = genericLiftCompare
instance Show1 Data.Syntax.Literal.Complex where liftShowsPrec = genericLiftShowsPrec
-- Strings, symbols
newtype String a = String { stringElements :: [a] }
deriving (Diffable, Eq, Foldable, Functor, GAlign, Generic1, Show, Traversable)
deriving (Diffable, Eq, Foldable, Functor, GAlign, Generic1, Mergeable, Ord, Show, Traversable)
instance Eq1 Data.Syntax.Literal.String where liftEq = genericLiftEq
instance Ord1 Data.Syntax.Literal.String where liftCompare = genericLiftCompare
instance Show1 Data.Syntax.Literal.String where liftShowsPrec = genericLiftShowsPrec
-- TODO: Should string literal bodies include escapes too?
-- | An interpolation element within a string literal.
newtype InterpolationElement a = InterpolationElement { interpolationBody :: a }
deriving (Diffable, Eq, Foldable, Functor, GAlign, Generic1, Show, Traversable)
deriving (Diffable, Eq, Foldable, Functor, GAlign, Generic1, Mergeable, Ord, Show, Traversable)
instance Eq1 InterpolationElement where liftEq = genericLiftEq
instance Ord1 InterpolationElement where liftCompare = genericLiftCompare
instance Show1 InterpolationElement where liftShowsPrec = genericLiftShowsPrec
-- | A sequence of textual contents within a string literal.
newtype TextElement a = TextElement { textElementContent :: ByteString }
deriving (Diffable, Eq, Foldable, Functor, GAlign, Generic1, Show, Traversable)
deriving (Diffable, Eq, Foldable, Functor, GAlign, Generic1, Mergeable, Ord, Show, Traversable)
instance Eq1 TextElement where liftEq = genericLiftEq
instance Ord1 TextElement where liftCompare = genericLiftCompare
instance Show1 TextElement where liftShowsPrec = genericLiftShowsPrec
data Null a = Null
deriving (Diffable, Eq, Foldable, Functor, GAlign, Generic1, Show, Traversable)
deriving (Diffable, Eq, Foldable, Functor, GAlign, Generic1, Mergeable, Ord, Show, Traversable)
instance Eq1 Null where liftEq = genericLiftEq
instance Ord1 Null where liftCompare = genericLiftCompare
instance Show1 Null where liftShowsPrec = genericLiftShowsPrec
newtype Symbol a = Symbol { symbolContent :: ByteString }
deriving (Diffable, Eq, Foldable, Functor, GAlign, Generic1, Show, Traversable)
deriving (Diffable, Eq, Foldable, Functor, GAlign, Generic1, Mergeable, Ord, Show, Traversable)
instance Eq1 Symbol where liftEq = genericLiftEq
instance Show1 Symbol where liftShowsPrec = genericLiftShowsPrec
newtype Regex a = Regex { regexContent :: ByteString }
deriving (Diffable, Eq, Foldable, Functor, GAlign, Generic1, Show, Traversable)
deriving (Diffable, Eq, Foldable, Functor, GAlign, Generic1, Mergeable, Ord, Show, Traversable)
instance Eq1 Regex where liftEq = genericLiftEq
instance Ord1 Regex where liftCompare = genericLiftCompare
instance Show1 Regex where liftShowsPrec = genericLiftShowsPrec
-- TODO: Heredoc-style string literals?
@ -109,36 +120,40 @@ instance Show1 Regex where liftShowsPrec = genericLiftShowsPrec
-- Collections
newtype Array a = Array { arrayElements :: [a] }
deriving (Diffable, Eq, Foldable, Functor, GAlign, Generic1, Show, Traversable)
deriving (Diffable, Eq, Foldable, Functor, GAlign, Generic1, Mergeable, Ord, Show, Traversable)
instance Eq1 Array where liftEq = genericLiftEq
instance Ord1 Array where liftCompare = genericLiftCompare
instance Show1 Array where liftShowsPrec = genericLiftShowsPrec
newtype Hash a = Hash { hashElements :: [a] }
deriving (Diffable, Eq, Foldable, Functor, GAlign, Generic1, Show, Traversable)
deriving (Diffable, Eq, Foldable, Functor, GAlign, Generic1, Mergeable, Ord, Show, Traversable)
instance Eq1 Hash where liftEq = genericLiftEq
instance Ord1 Hash where liftCompare = genericLiftCompare
instance Show1 Hash where liftShowsPrec = genericLiftShowsPrec
data KeyValue a = KeyValue { key :: !a, value :: !a }
deriving (Diffable, Eq, Foldable, Functor, GAlign, Generic1, Show, Traversable)
deriving (Diffable, Eq, Foldable, Functor, GAlign, Generic1, Mergeable, Ord, Show, Traversable)
instance Eq1 KeyValue where liftEq = genericLiftEq
instance Show1 KeyValue where liftShowsPrec = genericLiftShowsPrec
newtype Tuple a = Tuple { tupleContents :: [a]}
deriving (Diffable, Eq, Foldable, Functor, GAlign, Generic1, Show, Traversable)
deriving (Diffable, Eq, Foldable, Functor, GAlign, Generic1, Mergeable, Ord, Show, Traversable)
instance Eq1 Tuple where liftEq = genericLiftEq
instance Ord1 Tuple where liftCompare = genericLiftCompare
instance Show1 Tuple where liftShowsPrec = genericLiftShowsPrec
newtype Set a = Set { setElements :: [a] }
deriving (Diffable, Eq, Foldable, Functor, GAlign, Generic1, Show, Traversable)
deriving (Diffable, Eq, Foldable, Functor, GAlign, Generic1, Mergeable, Ord, Show, Traversable)
instance Eq1 Set where liftEq = genericLiftEq
instance Ord1 Set where liftCompare = genericLiftCompare
instance Show1 Set where liftShowsPrec = genericLiftShowsPrec
-- Misc

62
src/Data/Syntax/Markup.hs
View File

@ -5,132 +5,154 @@ import Algorithm
import Data.Align.Generic
import Data.ByteString (ByteString)
import Data.Functor.Classes.Eq.Generic
import Data.Functor.Classes.Ord.Generic
import Data.Functor.Classes.Show.Generic
import Data.Mergeable
import GHC.Generics
newtype Document a = Document [a]
deriving (Diffable, Eq, Foldable, Functor, GAlign, Generic1, Show, Traversable)
deriving (Diffable, Eq, Foldable, Functor, GAlign, Generic1, Mergeable, Ord, Show, Traversable)
instance Eq1 Document where liftEq = genericLiftEq
instance Ord1 Document where liftCompare = genericLiftCompare
instance Show1 Document where liftShowsPrec = genericLiftShowsPrec
-- Block elements
newtype Paragraph a = Paragraph [a]
deriving (Diffable, Eq, Foldable, Functor, GAlign, Generic1, Show, Traversable)
deriving (Diffable, Eq, Foldable, Functor, GAlign, Generic1, Mergeable, Ord, Show, Traversable)
instance Eq1 Paragraph where liftEq = genericLiftEq
instance Ord1 Paragraph where liftCompare = genericLiftCompare
instance Show1 Paragraph where liftShowsPrec = genericLiftShowsPrec
data Section a = Section { sectionLevel :: Int, sectionHeading :: a, sectionContent :: [a] }
deriving (Diffable, Eq, Foldable, Functor, GAlign, Generic1, Show, Traversable)
deriving (Diffable, Eq, Foldable, Functor, GAlign, Generic1, Mergeable, Ord, Show, Traversable)
instance Eq1 Section where liftEq = genericLiftEq
instance Ord1 Section where liftCompare = genericLiftCompare
instance Show1 Section where liftShowsPrec = genericLiftShowsPrec
data Heading a = Heading { headingLevel :: Int, headingContent :: [a] }
deriving (Diffable, Eq, Foldable, Functor, GAlign, Generic1, Show, Traversable)
deriving (Diffable, Eq, Foldable, Functor, GAlign, Generic1, Mergeable, Ord, Show, Traversable)
instance Eq1 Heading where liftEq = genericLiftEq
instance Ord1 Heading where liftCompare = genericLiftCompare
instance Show1 Heading where liftShowsPrec = genericLiftShowsPrec
newtype UnorderedList a = UnorderedList [a]
deriving (Diffable, Eq, Foldable, Functor, GAlign, Generic1, Show, Traversable)
deriving (Diffable, Eq, Foldable, Functor, GAlign, Generic1, Mergeable, Ord, Show, Traversable)
instance Eq1 UnorderedList where liftEq = genericLiftEq
instance Ord1 UnorderedList where liftCompare = genericLiftCompare
instance Show1 UnorderedList where liftShowsPrec = genericLiftShowsPrec
newtype OrderedList a = OrderedList [a]
deriving (Diffable, Eq, Foldable, Functor, GAlign, Generic1, Show, Traversable)
deriving (Diffable, Eq, Foldable, Functor, GAlign, Generic1, Mergeable, Ord, Show, Traversable)
instance Eq1 OrderedList where liftEq = genericLiftEq
instance Ord1 OrderedList where liftCompare = genericLiftCompare
instance Show1 OrderedList where liftShowsPrec = genericLiftShowsPrec
newtype BlockQuote a = BlockQuote [a]
deriving (Diffable, Eq, Foldable, Functor, GAlign, Generic1, Show, Traversable)
deriving (Diffable, Eq, Foldable, Functor, GAlign, Generic1, Mergeable, Ord, Show, Traversable)
instance Eq1 BlockQuote where liftEq = genericLiftEq
instance Ord1 BlockQuote where liftCompare = genericLiftCompare
instance Show1 BlockQuote where liftShowsPrec = genericLiftShowsPrec
data ThematicBreak a = ThematicBreak
deriving (Diffable, Eq, Foldable, Functor, GAlign, Generic1, Show, Traversable)
deriving (Diffable, Eq, Foldable, Functor, GAlign, Generic1, Mergeable, Ord, Show, Traversable)
instance Eq1 ThematicBreak where liftEq = genericLiftEq
instance Ord1 ThematicBreak where liftCompare = genericLiftCompare
instance Show1 ThematicBreak where liftShowsPrec = genericLiftShowsPrec
data HTMLBlock a = HTMLBlock ByteString
deriving (Diffable, Eq, Foldable, Functor, GAlign, Generic1, Show, Traversable)
deriving (Diffable, Eq, Foldable, Functor, GAlign, Generic1, Mergeable, Ord, Show, Traversable)
instance Eq1 HTMLBlock where liftEq = genericLiftEq
instance Ord1 HTMLBlock where liftCompare = genericLiftCompare
instance Show1 HTMLBlock where liftShowsPrec = genericLiftShowsPrec
newtype Table a = Table [a]
deriving (Diffable, Eq, Foldable, Functor, GAlign, Generic1, Show, Traversable)
deriving (Diffable, Eq, Foldable, Functor, GAlign, Generic1, Mergeable, Ord, Show, Traversable)
instance Eq1 Table where liftEq = genericLiftEq
instance Ord1 Table where liftCompare = genericLiftCompare
instance Show1 Table where liftShowsPrec = genericLiftShowsPrec
newtype TableRow a = TableRow [a]
deriving (Diffable, Eq, Foldable, Functor, GAlign, Generic1, Show, Traversable)
deriving (Diffable, Eq, Foldable, Functor, GAlign, Generic1, Mergeable, Ord, Show, Traversable)
instance Eq1 TableRow where liftEq = genericLiftEq
instance Ord1 TableRow where liftCompare = genericLiftCompare
instance Show1 TableRow where liftShowsPrec = genericLiftShowsPrec
newtype TableCell a = TableCell [a]
deriving (Diffable, Eq, Foldable, Functor, GAlign, Generic1, Show, Traversable)
deriving (Diffable, Eq, Foldable, Functor, GAlign, Generic1, Mergeable, Ord, Show, Traversable)
instance Eq1 TableCell where liftEq = genericLiftEq
instance Ord1 TableCell where liftCompare = genericLiftCompare
instance Show1 TableCell where liftShowsPrec = genericLiftShowsPrec
-- Inline elements
newtype Strong a = Strong [a]
deriving (Diffable, Eq, Foldable, Functor, GAlign, Generic1, Show, Traversable)
deriving (Diffable, Eq, Foldable, Functor, GAlign, Generic1, Mergeable, Ord, Show, Traversable)
instance Eq1 Strong where liftEq = genericLiftEq
instance Ord1 Strong where liftCompare = genericLiftCompare
instance Show1 Strong where liftShowsPrec = genericLiftShowsPrec
newtype Emphasis a = Emphasis [a]
deriving (Diffable, Eq, Foldable, Functor, GAlign, Generic1, Show, Traversable)
deriving (Diffable, Eq, Foldable, Functor, GAlign, Generic1, Mergeable, Ord, Show, Traversable)
instance Eq1 Emphasis where liftEq = genericLiftEq
instance Ord1 Emphasis where liftCompare = genericLiftCompare
instance Show1 Emphasis where liftShowsPrec = genericLiftShowsPrec
newtype Text a = Text ByteString
deriving (Diffable, Eq, Foldable, Functor, GAlign, Generic1, Show, Traversable)
deriving (Diffable, Eq, Foldable, Functor, GAlign, Generic1, Mergeable, Ord, Show, Traversable)
instance Eq1 Text where liftEq = genericLiftEq
instance Ord1 Text where liftCompare = genericLiftCompare
instance Show1 Text where liftShowsPrec = genericLiftShowsPrec
data Link a = Link { linkURL :: ByteString, linkTitle :: Maybe ByteString }
deriving (Diffable, Eq, Foldable, Functor, GAlign, Generic1, Show, Traversable)
deriving (Diffable, Eq, Foldable, Functor, GAlign, Generic1, Mergeable, Ord, Show, Traversable)
instance Eq1 Link where liftEq = genericLiftEq
instance Ord1 Link where liftCompare = genericLiftCompare
instance Show1 Link where liftShowsPrec = genericLiftShowsPrec
data Image a = Image { imageURL :: ByteString, imageTitle :: Maybe ByteString }
deriving (Diffable, Eq, Foldable, Functor, GAlign, Generic1, Show, Traversable)
deriving (Diffable, Eq, Foldable, Functor, GAlign, Generic1, Mergeable, Ord, Show, Traversable)
instance Eq1 Image where liftEq = genericLiftEq
instance Ord1 Image where liftCompare = genericLiftCompare
instance Show1 Image where liftShowsPrec = genericLiftShowsPrec
data Code a = Code { codeLanguage :: Maybe ByteString, codeContent :: ByteString }
deriving (Diffable, Eq, Foldable, Functor, GAlign, Generic1, Show, Traversable)
deriving (Diffable, Eq, Foldable, Functor, GAlign, Generic1, Mergeable, Ord, Show, Traversable)
instance Eq1 Code where liftEq = genericLiftEq
instance Ord1 Code where liftCompare = genericLiftCompare
instance Show1 Code where liftShowsPrec = genericLiftShowsPrec
data LineBreak a = LineBreak
deriving (Diffable, Eq, Foldable, Functor, GAlign, Generic1, Show, Traversable)
deriving (Diffable, Eq, Foldable, Functor, GAlign, Generic1, Mergeable, Ord, Show, Traversable)
instance Eq1 LineBreak where liftEq = genericLiftEq
instance Ord1 LineBreak where liftCompare = genericLiftCompare
instance Show1 LineBreak where liftShowsPrec = genericLiftShowsPrec
newtype Strikethrough a = Strikethrough [a]
deriving (Diffable, Eq, Foldable, Functor, GAlign, Generic1, Show, Traversable)
deriving (Diffable, Eq, Foldable, Functor, GAlign, Generic1, Mergeable, Ord, Show, Traversable)
instance Eq1 Strikethrough where liftEq = genericLiftEq
instance Ord1 Strikethrough where liftCompare = genericLiftCompare
instance Show1 Strikethrough where liftShowsPrec = genericLiftShowsPrec

13
src/Data/Syntax/Type.hs
View File

@ -4,14 +4,16 @@ module Data.Syntax.Type where
import Algorithm
import Data.Align.Generic
import Data.Functor.Classes.Eq.Generic
import Data.Functor.Classes.Ord.Generic
import Data.Functor.Classes.Show.Generic
import Data.Mergeable
import GHC.Generics
data Annotation a = Annotation { annotationSubject :: !a, annotationType :: !a }
deriving (Diffable, Eq, Foldable, Functor, GAlign, Generic1, Mergeable, Show, Traversable)
deriving (Diffable, Eq, Foldable, Functor, GAlign, Generic1, Mergeable, Ord, Show, Traversable)
instance Eq1 Annotation where liftEq = genericLiftEq
instance Ord1 Annotation where liftCompare = genericLiftCompare
instance Show1 Annotation where liftShowsPrec = genericLiftShowsPrec
data Function a = Function { functionParameters :: [a], functionReturn :: a }
@ -21,9 +23,10 @@ instance Eq1 Function where liftEq = genericLiftEq
instance Show1 Function where liftShowsPrec = genericLiftShowsPrec
newtype Product a = Product { productElements :: [a] }
deriving (Diffable, Eq, Foldable, Functor, GAlign, Generic1, Mergeable, Show, Traversable)
deriving (Diffable, Eq, Foldable, Functor, GAlign, Generic1, Mergeable, Ord, Show, Traversable)
instance Eq1 Product where liftEq = genericLiftEq
instance Ord1 Product where liftCompare = genericLiftCompare
instance Show1 Product where liftShowsPrec = genericLiftShowsPrec
data Array a = Array { arraySize :: Maybe a, arrayElementType :: a }
@ -75,13 +78,15 @@ instance Eq1 Slice where liftEq = genericLiftEq
instance Show1 Slice where liftShowsPrec = genericLiftShowsPrec
data TypeParameters a = TypeParameters { typeParameters :: ![a] }
deriving (Diffable, Eq, Foldable, Functor, GAlign, Generic1, Show, Traversable)
deriving (Diffable, Eq, Foldable, Functor, GAlign, Generic1, Mergeable, Ord, Show, Traversable)
instance Eq1 TypeParameters where liftEq = genericLiftEq
instance Ord1 TypeParameters where liftCompare = genericLiftCompare
instance Show1 TypeParameters where liftShowsPrec = genericLiftShowsPrec
data Readonly a = Readonly
deriving (Diffable, Eq, Foldable, Functor, GAlign, Generic1, Show, Traversable)
deriving (Diffable, Eq, Foldable, Functor, GAlign, Generic1, Mergeable, Ord, Show, Traversable)
instance Eq1 Readonly where liftEq = genericLiftEq
instance Ord1 Readonly where liftCompare = genericLiftCompare
instance Show1 Readonly where liftShowsPrec = genericLiftShowsPrec

2
src/Language.hs
View File

@ -20,7 +20,7 @@ data Language
| Python
| Ruby
| TypeScript
deriving (Show, Eq, Read, Generic, ToJSON)
deriving (Eq, Generic, Ord, Read, Show, ToJSON)
-- | Returns a Language based on the file extension (including the ".").
languageForType :: String -> Maybe Language

8
src/Language/Python/Syntax.hs
View File

@ -10,9 +10,11 @@ import Algorithm
import Data.Align.Generic
import Data.Functor (void)
import Data.Functor.Classes.Eq.Generic
import Data.Functor.Classes.Ord.Generic
import Data.Functor.Classes.Show.Generic
import Data.List.NonEmpty (some1)
import Data.Maybe (fromMaybe)
import Data.Mergeable
import Data.Record
import Data.Syntax (contextualize, emptyTerm, handleError, infixContext, makeTerm, makeTerm', makeTerm1, parseError, postContextualize)
import qualified Data.Syntax as Syntax
@ -91,16 +93,18 @@ type Assignment = HasCallStack => Assignment.Assignment [] Grammar Term
-- | Ellipsis (used in splice expressions and alternatively can be used as a fill in expression, like `undefined` in Haskell)
data Ellipsis a = Ellipsis
deriving (Diffable, Eq, Foldable, Functor, GAlign, Generic1, Show, Traversable)
deriving (Diffable, Eq, Foldable, Functor, GAlign, Generic1, Mergeable, Ord, Show, Traversable)
instance Eq1 Ellipsis where liftEq = genericLiftEq
instance Ord1 Ellipsis where liftCompare = genericLiftCompare
instance Show1 Ellipsis where liftShowsPrec = genericLiftShowsPrec
data Redirect a = Redirect !a !a
deriving (Diffable, Eq, Foldable, Functor, GAlign, Generic1, Show, Traversable)
deriving (Diffable, Eq, Foldable, Functor, GAlign, Generic1, Mergeable, Ord, Show, Traversable)
instance Eq1 Redirect where liftEq = genericLiftEq
instance Ord1 Redirect where liftCompare = genericLiftCompare
instance Show1 Redirect where liftShowsPrec = genericLiftShowsPrec
-- | Assignment from AST in Python's grammar onto a program in Python's syntax.

4
src/Language/Ruby/Syntax.hs
View File

@ -10,7 +10,7 @@ import Data.Maybe (fromMaybe)
import Data.Record
import Data.Functor (void)
import Data.List.NonEmpty (some1)
import Data.Syntax (postContextualize, emptyTerm, parseError, handleError, infixContext, makeTerm, makeTerm', makeTerm1)
import Data.Syntax (contextualize, postContextualize, emptyTerm, parseError, handleError, infixContext, makeTerm, makeTerm', makeTerm1)
import qualified Data.Syntax as Syntax
import Data.Syntax.Assignment hiding (Assignment, Error)
import qualified Data.Syntax.Assignment as Assignment
@ -401,7 +401,7 @@ invert term = makeTerm <$> location <*> fmap Expression.Not term
-- | Match a term optionally preceded by comment(s), or a sequence of comments if the term is not present.
term :: Assignment -> Assignment
term term = many comment *> term <|> makeTerm1 <$> (Syntax.Context <$> some1 comment <*> emptyTerm)
term term = contextualize comment term <|> makeTerm1 <$> (Syntax.Context <$> some1 comment <*> emptyTerm)
-- | Match a series of terms or comments until a delimiter is matched.
manyTermsTill :: Show b => Assignment.Assignment [] Grammar Term -> Assignment.Assignment [] Grammar b -> Assignment.Assignment [] Grammar [Term]

230
src/Language/TypeScript/Syntax.hs
View File

@ -11,10 +11,12 @@ module Language.TypeScript.Syntax
import Algorithm
import GHC.Generics
import Data.Functor.Classes.Eq.Generic
import Data.Functor.Classes.Ord.Generic
import Data.Functor.Classes.Show.Generic
import Data.ByteString (ByteString)
import Data.Align.Generic
import Data.Maybe (fromMaybe)
import Data.Mergeable
import Data.Record
import Data.Maybe (catMaybes)
import Data.Syntax (emptyTerm, handleError, parseError, infixContext, makeTerm, makeTerm', makeTerm1, postContextualize)
@ -179,460 +181,536 @@ type Assignment = HasCallStack => Assignment.Assignment [] Grammar Term
-- | ShorthandPropertyIdentifier used in object patterns such as var baz = { foo } to mean var baz = { foo: foo }
newtype ShorthandPropertyIdentifier a = ShorthandPropertyIdentifier ByteString
deriving (Diffable, Eq, Foldable, Functor, GAlign, Generic1, Show, Traversable)
deriving (Diffable, Eq, Foldable, Functor, GAlign, Generic1, Mergeable, Ord, Show, Traversable)
instance Eq1 ShorthandPropertyIdentifier where liftEq = genericLiftEq
instance Ord1 ShorthandPropertyIdentifier where liftCompare = genericLiftCompare
instance Show1 ShorthandPropertyIdentifier where liftShowsPrec = genericLiftShowsPrec
data Union a = Union { unionLeft :: !a, unionRight :: !a }
deriving (Diffable, Eq, Foldable, Functor, GAlign, Generic1, Show, Traversable)
deriving (Diffable, Eq, Foldable, Functor, GAlign, Generic1, Mergeable, Ord, Show, Traversable)
instance Eq1 Language.TypeScript.Syntax.Union where liftEq = genericLiftEq
instance Ord1 Language.TypeScript.Syntax.Union where liftCompare = genericLiftCompare
instance Show1 Language.TypeScript.Syntax.Union where liftShowsPrec = genericLiftShowsPrec
data Intersection a = Intersection { intersectionLeft :: !a, intersectionRight :: !a }
deriving (Diffable, Eq, Foldable, Functor, GAlign, Generic1, Show, Traversable)
deriving (Diffable, Eq, Foldable, Functor, GAlign, Generic1, Mergeable, Ord, Show, Traversable)
instance Eq1 Intersection where liftEq = genericLiftEq
instance Ord1 Intersection where liftCompare = genericLiftCompare
instance Show1 Intersection where liftShowsPrec = genericLiftShowsPrec
data PublicFieldDefinition a = PublicFieldDefinition { publicFieldContext :: ![a], publicFieldPropertyName :: !a, publicFieldValue :: !a }
deriving (Diffable, Eq, Foldable, Functor, GAlign, Generic1, Show, Traversable)
deriving (Diffable, Eq, Foldable, Functor, GAlign, Generic1, Mergeable, Ord, Show, Traversable)
instance Eq1 PublicFieldDefinition where liftEq = genericLiftEq
instance Ord1 PublicFieldDefinition where liftCompare = genericLiftCompare
instance Show1 PublicFieldDefinition where liftShowsPrec = genericLiftShowsPrec
data FunctionType a = FunctionType { functionTypeParameters :: !a, functionFormalParameters :: ![a], functionType :: !a }
deriving (Diffable, Eq, Foldable, Functor, GAlign, Generic1, Show, Traversable)
deriving (Diffable, Eq, Foldable, Functor, GAlign, Generic1, Mergeable, Ord, Show, Traversable)
instance Eq1 FunctionType where liftEq = genericLiftEq
instance Ord1 FunctionType where liftCompare = genericLiftCompare
instance Show1 FunctionType where liftShowsPrec = genericLiftShowsPrec
data AmbientFunction a = AmbientFunction { ambientFunctionContext :: ![a], ambientFunctionIdentifier :: !a, ambientFunctionParameters :: ![a] }
deriving (Diffable, Eq, Foldable, Functor, GAlign, Generic1, Show, Traversable)
deriving (Diffable, Eq, Foldable, Functor, GAlign, Generic1, Mergeable, Ord, Show, Traversable)
instance Eq1 AmbientFunction where liftEq = genericLiftEq
instance Ord1 AmbientFunction where liftCompare = genericLiftCompare
instance Show1 AmbientFunction where liftShowsPrec = genericLiftShowsPrec
data ImportRequireClause a = ImportRequireClause { importRequireIdentifier :: !a, importRequireSubject :: !a }
deriving (Diffable, Eq, Foldable, Functor, GAlign, Generic1, Show, Traversable)
deriving (Diffable, Eq, Foldable, Functor, GAlign, Generic1, Mergeable, Ord, Show, Traversable)
instance Eq1 ImportRequireClause where liftEq = genericLiftEq
instance Ord1 ImportRequireClause where liftCompare = genericLiftCompare
instance Show1 ImportRequireClause where liftShowsPrec = genericLiftShowsPrec
newtype ImportClause a = ImportClause { importClauseElements :: [a] }
deriving (Diffable, Eq, Foldable, Functor, GAlign, Generic1, Show, Traversable)
deriving (Diffable, Eq, Foldable, Functor, GAlign, Generic1, Mergeable, Ord, Show, Traversable)
instance Eq1 ImportClause where liftEq = genericLiftEq
instance Ord1 ImportClause where liftCompare = genericLiftCompare
instance Show1 ImportClause where liftShowsPrec = genericLiftShowsPrec
newtype NamespaceImport a = NamespaceImport { namespaceImportSubject :: a }
deriving (Diffable, Eq, Foldable, Functor, GAlign, Generic1, Show, Traversable)
deriving (Diffable, Eq, Foldable, Functor, GAlign, Generic1, Mergeable, Ord, Show, Traversable)
instance Eq1 NamespaceImport where liftEq = genericLiftEq
instance Ord1 NamespaceImport where liftCompare = genericLiftCompare
instance Show1 NamespaceImport where liftShowsPrec = genericLiftShowsPrec
newtype Tuple a = Tuple { tupleElements :: [a] }
deriving (Diffable, Eq, Foldable, Functor, GAlign, Generic1, Show, Traversable)
deriving (Diffable, Eq, Foldable, Functor, GAlign, Generic1, Mergeable, Ord, Show, Traversable)
instance Eq1 Tuple where liftEq = genericLiftEq
instance Ord1 Tuple where liftCompare = genericLiftCompare
instance Show1 Tuple where liftShowsPrec = genericLiftShowsPrec
data Constructor a = Constructor { constructorTypeParameters :: !a, constructorFormalParameters :: ![a], constructorType :: !a }
deriving (Diffable, Eq, Foldable, Functor, GAlign, Generic1, Show, Traversable)
deriving (Diffable, Eq, Foldable, Functor, GAlign, Generic1, Mergeable, Ord, Show, Traversable)
instance Eq1 Language.TypeScript.Syntax.Constructor where liftEq = genericLiftEq
instance Ord1 Language.TypeScript.Syntax.Constructor where liftCompare = genericLiftCompare
instance Show1 Language.TypeScript.Syntax.Constructor where liftShowsPrec = genericLiftShowsPrec
data TypeParameter a = TypeParameter { typeParameter :: !a, typeParameterConstraint :: !a }
deriving (Diffable, Eq, Foldable, Functor, GAlign, Generic1, Show, Traversable)
deriving (Diffable, Eq, Foldable, Functor, GAlign, Generic1, Mergeable, Ord, Show, Traversable)
instance Eq1 TypeParameter where liftEq = genericLiftEq
instance Ord1 TypeParameter where liftCompare = genericLiftCompare
instance Show1 TypeParameter where liftShowsPrec = genericLiftShowsPrec
data TypeAssertion a = TypeAssertion { typeAssertionParameters :: !a, typeAssertionExpression :: !a }
deriving (Diffable, Eq, Foldable, Functor, GAlign, Generic1, Show, Traversable)
deriving (Diffable, Eq, Foldable, Functor, GAlign, Generic1, Mergeable, Ord, Show, Traversable)
instance Eq1 TypeAssertion where liftEq = genericLiftEq
instance Ord1 TypeAssertion where liftCompare = genericLiftCompare
instance Show1 TypeAssertion where liftShowsPrec = genericLiftShowsPrec
data Cast a = Cast { castSubject :: !a, castType :: !a }
deriving (Diffable, Eq, Foldable, Functor, GAlign, Generic1, Show, Traversable)
deriving (Diffable, Eq, Foldable, Functor, GAlign, Generic1, Mergeable, Ord, Show, Traversable)
instance Eq1 Cast where liftEq = genericLiftEq
instance Ord1 Cast where liftCompare = genericLiftCompare
instance Show1 Cast where liftShowsPrec = genericLiftShowsPrec
newtype Annotation a = Annotation { annotationType :: a }
deriving (Diffable, Eq, Foldable, Functor, GAlign, Generic1, Show, Traversable)
deriving (Diffable, Eq, Foldable, Functor, GAlign, Generic1, Mergeable, Ord, Show, Traversable)
instance Eq1 Annotation where liftEq = genericLiftEq
instance Ord1 Annotation where liftCompare = genericLiftCompare
instance Show1 Annotation where liftShowsPrec = genericLiftShowsPrec
newtype ComputedPropertyName a = ComputedPropertyName a
deriving (Diffable, Eq, Foldable, Functor, GAlign, Generic1, Show, Traversable)
deriving (Diffable, Eq, Foldable, Functor, GAlign, Generic1, Mergeable, Ord, Show, Traversable)
instance Eq1 ComputedPropertyName where liftEq = genericLiftEq
instance Ord1 ComputedPropertyName where liftCompare = genericLiftCompare
instance Show1 ComputedPropertyName where liftShowsPrec = genericLiftShowsPrec
newtype Constraint a = Constraint { constraintType :: a }
deriving (Diffable, Eq, Foldable, Functor, GAlign, Generic1, Show, Traversable)
deriving (Diffable, Eq, Foldable, Functor, GAlign, Generic1, Mergeable, Ord, Show, Traversable)
instance Eq1 Constraint where liftEq = genericLiftEq
instance Ord1 Constraint where liftCompare = genericLiftCompare
instance Show1 Constraint where liftShowsPrec = genericLiftShowsPrec
newtype ParenthesizedType a = ParenthesizedType { parenthesizedType :: a }
deriving (Diffable, Eq, Foldable, Functor, GAlign, Generic1, Show, Traversable)
deriving (Diffable, Eq, Foldable, Functor, GAlign, Generic1, Mergeable, Ord, Show, Traversable)
instance Eq1 ParenthesizedType where liftEq = genericLiftEq
instance Ord1 ParenthesizedType where liftCompare = genericLiftCompare
instance Show1 ParenthesizedType where liftShowsPrec = genericLiftShowsPrec
newtype PredefinedType a = PredefinedType { predefinedType :: ByteString }
deriving (Diffable, Eq, Foldable, Functor, GAlign, Generic1, Show, Traversable)
deriving (Diffable, Eq, Foldable, Functor, GAlign, Generic1, Mergeable, Ord, Show, Traversable)
instance Eq1 PredefinedType where liftEq = genericLiftEq
instance Ord1 PredefinedType where liftCompare = genericLiftCompare
instance Show1 PredefinedType where liftShowsPrec = genericLiftShowsPrec
newtype TypeIdentifier a = TypeIdentifier ByteString
deriving (Diffable, Eq, Foldable, Functor, GAlign, Generic1, Show, Traversable)
deriving (Diffable, Eq, Foldable, Functor, GAlign, Generic1, Mergeable, Ord, Show, Traversable)
instance Eq1 TypeIdentifier where liftEq = genericLiftEq
instance Ord1 TypeIdentifier where liftCompare = genericLiftCompare
instance Show1 TypeIdentifier where liftShowsPrec = genericLiftShowsPrec
data NestedIdentifier a = NestedIdentifier !a !a
deriving (Diffable, Eq, Foldable, Functor, GAlign, Generic1, Show, Traversable)
deriving (Diffable, Eq, Foldable, Functor, GAlign, Generic1, Mergeable, Ord, Show, Traversable)
instance Eq1 NestedIdentifier where liftEq = genericLiftEq
instance Ord1 NestedIdentifier where liftCompare = genericLiftCompare
instance Show1 NestedIdentifier where liftShowsPrec = genericLiftShowsPrec
data NestedTypeIdentifier a = NestedTypeIdentifier !a !a
deriving (Diffable, Eq, Foldable, Functor, GAlign, Generic1, Show, Traversable)
deriving (Diffable, Eq, Foldable, Functor, GAlign, Generic1, Mergeable, Ord, Show, Traversable)
instance Eq1 NestedTypeIdentifier where liftEq = genericLiftEq
instance Ord1 NestedTypeIdentifier where liftCompare = genericLiftCompare
instance Show1 NestedTypeIdentifier where liftShowsPrec = genericLiftShowsPrec
data GenericType a = GenericType { genericTypeIdentifier :: !a, genericTypeArguments :: !a }
deriving (Diffable, Eq, Foldable, Functor, GAlign, Generic1, Show, Traversable)
deriving (Diffable, Eq, Foldable, Functor, GAlign, Generic1, Mergeable, Ord, Show, Traversable)
instance Eq1 GenericType where liftEq = genericLiftEq
instance Ord1 GenericType where liftCompare = genericLiftCompare
instance Show1 GenericType where liftShowsPrec = genericLiftShowsPrec
data TypePredicate a = TypePredicate { typePredicateIdentifier :: !a, typePredicateType :: !a }
deriving (Diffable, Eq, Foldable, Functor, GAlign, Generic1, Show, Traversable)
deriving (Diffable, Eq, Foldable, Functor, GAlign, Generic1, Mergeable, Ord, Show, Traversable)
instance Eq1 TypePredicate where liftEq = genericLiftEq
instance Ord1 TypePredicate where liftCompare = genericLiftCompare
instance Show1 TypePredicate where liftShowsPrec = genericLiftShowsPrec
newtype ObjectType a = ObjectType { objectTypeElements :: [a] }
deriving (Diffable, Eq, Foldable, Functor, GAlign, Generic1, Show, Traversable)
deriving (Diffable, Eq, Foldable, Functor, GAlign, Generic1, Mergeable, Ord, Show, Traversable)
instance Eq1 ObjectType where liftEq = genericLiftEq
instance Ord1 ObjectType where liftCompare = genericLiftCompare
instance Show1 ObjectType where liftShowsPrec = genericLiftShowsPrec
newtype Export a = Export { exportElements :: [a] }
deriving (Diffable, Eq, Foldable, Functor, GAlign, Generic1, Show, Traversable)
deriving (Diffable, Eq, Foldable, Functor, GAlign, Generic1, Mergeable, Ord, Show, Traversable)
instance Eq1 Export where liftEq = genericLiftEq
instance Ord1 Export where liftCompare = genericLiftCompare
instance Show1 Export where liftShowsPrec = genericLiftShowsPrec
newtype ExportClause a = ExportClause { exportClauseElements :: [a] }
deriving (Diffable, Eq, Foldable, Functor, GAlign, Generic1, Show, Traversable)
deriving (Diffable, Eq, Foldable, Functor, GAlign, Generic1, Mergeable, Ord, Show, Traversable)
instance Eq1 ExportClause where liftEq = genericLiftEq
instance Ord1 ExportClause where liftCompare = genericLiftCompare
instance Show1 ExportClause where liftShowsPrec = genericLiftShowsPrec
data ImportExportSpecifier a = ImportExportSpecifier { specifierSubject :: !a, specifierAlias :: !a }
deriving (Diffable, Eq, Foldable, Functor, GAlign, Generic1, Show, Traversable)
deriving (Diffable, Eq, Foldable, Functor, GAlign, Generic1, Mergeable, Ord, Show, Traversable)
instance Eq1 ImportExportSpecifier where liftEq = genericLiftEq
instance Ord1 ImportExportSpecifier where liftCompare = genericLiftCompare
instance Show1 ImportExportSpecifier where liftShowsPrec = genericLiftShowsPrec
newtype NamedImports a = NamedImports { namedImportElements :: [a] }
deriving (Diffable, Eq, Foldable, Functor, GAlign, Generic1, Show, Traversable)
deriving (Diffable, Eq, Foldable, Functor, GAlign, Generic1, Mergeable, Ord, Show, Traversable)
instance Eq1 NamedImports where liftEq = genericLiftEq
instance Ord1 NamedImports where liftCompare = genericLiftCompare
instance Show1 NamedImports where liftShowsPrec = genericLiftShowsPrec
data With a = With { withExpression :: !a, withBody :: !a }
deriving (Diffable, Eq, Foldable, Functor, GAlign, Generic1, Show, Traversable)
deriving (Diffable, Eq, Foldable, Functor, GAlign, Generic1, Mergeable, Ord, Show, Traversable)
instance Eq1 With where liftEq = genericLiftEq
instance Ord1 With where liftCompare = genericLiftCompare
instance Show1 With where liftShowsPrec = genericLiftShowsPrec
newtype AmbientDeclaration a = AmbientDeclaration { ambientDeclarationBody :: a }
deriving (Diffable, Eq, Foldable, Functor, GAlign, Generic1, Show, Traversable)
deriving (Diffable, Eq, Foldable, Functor, GAlign, Generic1, Mergeable, Ord, Show, Traversable)
instance Eq1 AmbientDeclaration where liftEq = genericLiftEq
instance Ord1 AmbientDeclaration where liftCompare = genericLiftCompare
instance Show1 AmbientDeclaration where liftShowsPrec = genericLiftShowsPrec
data InterfaceDeclaration a = InterfaceDeclaration { interfaceDeclarationContext :: ![a], interfaceDeclarationIdentifier :: !a, interfaceDeclarationBody :: !a }
deriving (Diffable, Eq, Foldable, Functor, GAlign, Generic1, Show, Traversable)
deriving (Diffable, Eq, Foldable, Functor, GAlign, Generic1, Mergeable, Ord, Show, Traversable)
instance Eq1 InterfaceDeclaration where liftEq = genericLiftEq
instance Ord1 InterfaceDeclaration where liftCompare = genericLiftCompare
instance Show1 InterfaceDeclaration where liftShowsPrec = genericLiftShowsPrec
data EnumDeclaration a = EnumDeclaration { enumDeclarationIdentifier :: !a, enumDeclarationBody :: ![a] }
deriving (Diffable, Eq, Foldable, Functor, GAlign, Generic1, Show, Traversable)
deriving (Diffable, Eq, Foldable, Functor, GAlign, Generic1, Mergeable, Ord, Show, Traversable)
instance Eq1 EnumDeclaration where liftEq = genericLiftEq
instance Ord1 EnumDeclaration where liftCompare = genericLiftCompare
instance Show1 EnumDeclaration where liftShowsPrec = genericLiftShowsPrec
data TypeAliasDeclaration a = TypeAliasDeclaration { typeAliasDeclarationContext :: ![a], typeAliasDeclarationIdentifier :: !a, typeAliasDeclarationType :: !a }
deriving (Diffable, Eq, Foldable, Functor, GAlign, Generic1, Show, Traversable)
deriving (Diffable, Eq, Foldable, Functor, GAlign, Generic1, Mergeable, Ord, Show, Traversable)
instance Eq1 TypeAliasDeclaration where liftEq = genericLiftEq
instance Ord1 TypeAliasDeclaration where liftCompare = genericLiftCompare
instance Show1 TypeAliasDeclaration where liftShowsPrec = genericLiftShowsPrec
newtype ExtendsClause a = ExtendsClause { extendsClauseTypes :: [a] }
deriving (Diffable, Eq, Foldable, Functor, GAlign, Generic1, Show, Traversable)
deriving (Diffable, Eq, Foldable, Functor, GAlign, Generic1, Mergeable, Ord, Show, Traversable)
instance Eq1 ExtendsClause where liftEq = genericLiftEq
instance Ord1 ExtendsClause where liftCompare = genericLiftCompare
instance Show1 ExtendsClause where liftShowsPrec = genericLiftShowsPrec
newtype Import a = Import { importElements :: [a] }
deriving (Diffable, Eq, Foldable, Functor, GAlign, Generic1, Show, Traversable)
deriving (Diffable, Eq, Foldable, Functor, GAlign, Generic1, Mergeable, Ord, Show, Traversable)
instance Eq1 Import where liftEq = genericLiftEq
instance Ord1 Import where liftCompare = genericLiftCompare
instance Show1 Import where liftShowsPrec = genericLiftShowsPrec
newtype ArrayType a = ArrayType { arrayType :: a }
deriving (Diffable, Eq, Foldable, Functor, GAlign, Generic1, Show, Traversable)
deriving (Diffable, Eq, Foldable, Functor, GAlign, Generic1, Mergeable, Ord, Show, Traversable)
instance Eq1 ArrayType where liftEq = genericLiftEq
instance Ord1 ArrayType where liftCompare = genericLiftCompare
instance Show1 ArrayType where liftShowsPrec = genericLiftShowsPrec
newtype FlowMaybeType a = FlowMaybeType { flowMaybeType :: a }
deriving (Diffable, Eq, Foldable, Functor, GAlign, Generic1, Show, Traversable)
deriving (Diffable, Eq, Foldable, Functor, GAlign, Generic1, Mergeable, Ord, Show, Traversable)
instance Eq1 FlowMaybeType where liftEq = genericLiftEq
instance Ord1 FlowMaybeType where liftCompare = genericLiftCompare
instance Show1 FlowMaybeType where liftShowsPrec = genericLiftShowsPrec
newtype TypeQuery a = TypeQuery { typeQuerySubject :: a }
deriving (Diffable, Eq, Foldable, Functor, GAlign, Generic1, Show, Traversable)
deriving (Diffable, Eq, Foldable, Functor, GAlign, Generic1, Mergeable, Ord, Show, Traversable)
instance Eq1 TypeQuery where liftEq = genericLiftEq
instance Ord1 TypeQuery where liftCompare = genericLiftCompare
instance Show1 TypeQuery where liftShowsPrec = genericLiftShowsPrec
newtype IndexTypeQuery a = IndexTypeQuery { indexTypeQuerySubject :: a }
deriving (Diffable, Eq, Foldable, Functor, GAlign, Generic1, Show, Traversable)
deriving (Diffable, Eq, Foldable, Functor, GAlign, Generic1, Mergeable, Ord, Show, Traversable)
instance Eq1 IndexTypeQuery where liftEq = genericLiftEq
instance Ord1 IndexTypeQuery where liftCompare = genericLiftCompare
instance Show1 IndexTypeQuery where liftShowsPrec = genericLiftShowsPrec
newtype TypeArguments a = TypeArguments { typeArguments :: [a] }
deriving (Diffable, Eq, Foldable, Functor, GAlign, Generic1, Show, Traversable)
deriving (Diffable, Eq, Foldable, Functor, GAlign, Generic1, Mergeable, Ord, Show, Traversable)
instance Eq1 TypeArguments where liftEq = genericLiftEq
instance Ord1 TypeArguments where liftCompare = genericLiftCompare
instance Show1 TypeArguments where liftShowsPrec = genericLiftShowsPrec
newtype ThisType a = ThisType ByteString
deriving (Diffable, Eq, Foldable, Functor, GAlign, Generic1, Show, Traversable)
deriving (Diffable, Eq, Foldable, Functor, GAlign, Generic1, Mergeable, Ord, Show, Traversable)
instance Eq1 ThisType where liftEq = genericLiftEq
instance Ord1 ThisType where liftCompare = genericLiftCompare
instance Show1 ThisType where liftShowsPrec = genericLiftShowsPrec
newtype ExistentialType a = ExistentialType ByteString
deriving (Diffable, Eq, Foldable, Functor, GAlign, Generic1, Show, Traversable)
deriving (Diffable, Eq, Foldable, Functor, GAlign, Generic1, Mergeable, Ord, Show, Traversable)
instance Eq1 ExistentialType where liftEq = genericLiftEq
instance Ord1 ExistentialType where liftCompare = genericLiftCompare
instance Show1 ExistentialType where liftShowsPrec = genericLiftShowsPrec
newtype LiteralType a = LiteralType { literalTypeSubject :: a }
deriving (Diffable, Eq, Foldable, Functor, GAlign, Generic1, Show, Traversable)
deriving (Diffable, Eq, Foldable, Functor, GAlign, Generic1, Mergeable, Ord, Show, Traversable)
instance Eq1 LiteralType where liftEq = genericLiftEq
instance Ord1 LiteralType where liftCompare = genericLiftCompare
instance Show1 LiteralType where liftShowsPrec = genericLiftShowsPrec
data PropertySignature a = PropertySignature { modifiers :: ![a], propertySignaturePropertyName :: !a }
deriving (Diffable, Eq, Foldable, Functor, GAlign, Generic1, Show, Traversable)
deriving (Diffable, Eq, Foldable, Functor, GAlign, Generic1, Mergeable, Ord, Show, Traversable)
instance Eq1 PropertySignature where liftEq = genericLiftEq
instance Ord1 PropertySignature where liftCompare = genericLiftCompare
instance Show1 PropertySignature where liftShowsPrec = genericLiftShowsPrec
data CallSignature a = CallSignature { callSignatureTypeParameters :: !a, callSignatureParameters :: ![a], callSignatureType :: !a }
deriving (Diffable, Eq, Foldable, Functor, GAlign, Generic1, Show, Traversable)
deriving (Diffable, Eq, Foldable, Functor, GAlign, Generic1, Mergeable, Ord, Show, Traversable)
instance Eq1 CallSignature where liftEq = genericLiftEq
instance Ord1 CallSignature where liftCompare = genericLiftCompare
instance Show1 CallSignature where liftShowsPrec = genericLiftShowsPrec
-- | Todo: Move type params and type to context
data ConstructSignature a = ConstructSignature { constructSignatureTypeParameters :: !a, constructSignatureParameters :: ![a], constructSignatureType :: !a }
deriving (Diffable, Eq, Foldable, Functor, GAlign, Generic1, Show, Traversable)
deriving (Diffable, Eq, Foldable, Functor, GAlign, Generic1, Mergeable, Ord, Show, Traversable)
instance Eq1 ConstructSignature where liftEq = genericLiftEq
instance Ord1 ConstructSignature where liftCompare = genericLiftCompare
instance Show1 ConstructSignature where liftShowsPrec = genericLiftShowsPrec
newtype IndexSignature a = IndexSignature { indexSignatureSubject :: a }
deriving (Diffable, Eq, Foldable, Functor, GAlign, Generic1, Show, Traversable)
deriving (Diffable, Eq, Foldable, Functor, GAlign, Generic1, Mergeable, Ord, Show, Traversable)
instance Eq1 IndexSignature where liftEq = genericLiftEq
instance Ord1 IndexSignature where liftCompare = genericLiftCompare
instance Show1 IndexSignature where liftShowsPrec = genericLiftShowsPrec
data MethodSignature a = MethodSignature { methodSignatureContext :: ![a], methodSignatureName :: !a, methodSignatureParameters :: ![a] }
deriving (Diffable, Eq, Foldable, Functor, GAlign, Generic1, Show, Traversable)
deriving (Diffable, Eq, Foldable, Functor, GAlign, Generic1, Mergeable, Ord, Show, Traversable)
instance Eq1 MethodSignature where liftEq = genericLiftEq
instance Ord1 MethodSignature where liftCompare = genericLiftCompare
instance Show1 MethodSignature where liftShowsPrec = genericLiftShowsPrec
data Debugger a = Debugger
deriving (Diffable, Eq, Foldable, Functor, GAlign, Generic1, Show, Traversable)
deriving (Diffable, Eq, Foldable, Functor, GAlign, Generic1, Mergeable, Ord, Show, Traversable)
instance Eq1 Debugger where liftEq = genericLiftEq
instance Ord1 Debugger where liftCompare = genericLiftCompare
instance Show1 Debugger where liftShowsPrec = genericLiftShowsPrec
data ForOf a = ForOf { forOfBinding :: !a, forOfSubject :: !a, forOfBody :: !a }
deriving (Diffable, Eq, Foldable, Functor, GAlign, Generic1, Show, Traversable)
deriving (Diffable, Eq, Foldable, Functor, GAlign, Generic1, Mergeable, Ord, Show, Traversable)
instance Eq1 ForOf where liftEq = genericLiftEq
instance Ord1 ForOf where liftCompare = genericLiftCompare
instance Show1 ForOf where liftShowsPrec = genericLiftShowsPrec
data This a = This
deriving (Diffable, Eq, Foldable, Functor, GAlign, Generic1, Show, Traversable)
deriving (Diffable, Eq, Foldable, Functor, GAlign, Generic1, Mergeable, Ord, Show, Traversable)
instance Eq1 This where liftEq = genericLiftEq
instance Ord1 This where liftCompare = genericLiftCompare
instance Show1 This where liftShowsPrec = genericLiftShowsPrec
data LabeledStatement a = LabeledStatement { labeledStatementIdentifier :: !a, labeledStatementSubject :: !a }
deriving (Diffable, Eq, Foldable, Functor, GAlign, Generic1, Show, Traversable)
deriving (Diffable, Eq, Foldable, Functor, GAlign, Generic1, Mergeable, Ord, Show, Traversable)
instance Eq1 LabeledStatement where liftEq = genericLiftEq
instance Ord1 LabeledStatement where liftCompare = genericLiftCompare
instance Show1 LabeledStatement where liftShowsPrec = genericLiftShowsPrec
newtype NonNullExpression a = NonNullExpression { nonNullExpression :: a }
deriving (Diffable, Eq, Foldable, Functor, GAlign, Generic1, Show, Traversable)
deriving (Diffable, Eq, Foldable, Functor, GAlign, Generic1, Mergeable, Ord, Show, Traversable)
instance Eq1 NonNullExpression where liftEq = genericLiftEq
instance Ord1 NonNullExpression where liftCompare = genericLiftCompare
instance Show1 NonNullExpression where liftShowsPrec = genericLiftShowsPrec
newtype Update a = Update { updateSubject :: a }
deriving (Diffable, Eq, Foldable, Functor, GAlign, Generic1, Show, Traversable)
deriving (Diffable, Eq, Foldable, Functor, GAlign, Generic1, Mergeable, Ord, Show, Traversable)
instance Eq1 Update where liftEq = genericLiftEq
instance Ord1 Update where liftCompare = genericLiftCompare
instance Show1 Update where liftShowsPrec = genericLiftShowsPrec
newtype Await a = Await { awaitSubject :: a }
deriving (Diffable, Eq, Foldable, Functor, GAlign, Generic1, Show, Traversable)
deriving (Diffable, Eq, Foldable, Functor, GAlign, Generic1, Mergeable, Ord, Show, Traversable)
instance Eq1 Await where liftEq = genericLiftEq
instance Ord1 Await where liftCompare = genericLiftCompare
instance Show1 Await where liftShowsPrec = genericLiftShowsPrec
newtype New a = New { newSubject :: a }
deriving (Diffable, Eq, Foldable, Functor, GAlign, Generic1, Show, Traversable)
deriving (Diffable, Eq, Foldable, Functor, GAlign, Generic1, Mergeable, Ord, Show, Traversable)
instance Eq1 New where liftEq = genericLiftEq
instance Ord1 New where liftCompare = genericLiftCompare
instance Show1 New where liftShowsPrec = genericLiftShowsPrec
data ImportAlias a = ImportAlias { importAliasSubject :: !a, importAlias :: !a }
deriving (Diffable, Eq, Foldable, Functor, GAlign, Generic1, Show, Traversable)
deriving (Diffable, Eq, Foldable, Functor, GAlign, Generic1, Mergeable, Ord, Show, Traversable)
instance Eq1 ImportAlias where liftEq = genericLiftEq
instance Ord1 ImportAlias where liftCompare = genericLiftCompare
instance Show1 ImportAlias where liftShowsPrec = genericLiftShowsPrec
data InternalModule a = InternalModule { internalModuleIdentifier :: !a, internalModuleStatements :: ![a] }
deriving (Diffable, Eq, Foldable, Functor, GAlign, Generic1, Show, Traversable)
deriving (Diffable, Eq, Foldable, Functor, GAlign, Generic1, Mergeable, Ord, Show, Traversable)
instance Eq1 InternalModule where liftEq = genericLiftEq
instance Ord1 InternalModule where liftCompare = genericLiftCompare
instance Show1 InternalModule where liftShowsPrec = genericLiftShowsPrec
data Super a = Super
deriving (Diffable, Eq, Foldable, Functor, GAlign, Generic1, Show, Traversable)
deriving (Diffable, Eq, Foldable, Functor, GAlign, Generic1, Mergeable, Ord, Show, Traversable)
instance Eq1 Super where liftEq = genericLiftEq
instance Ord1 Super where liftCompare = genericLiftCompare
instance Show1 Super where liftShowsPrec = genericLiftShowsPrec
data Undefined a = Undefined
deriving (Diffable, Eq, Foldable, Functor, GAlign, Generic1, Show, Traversable)
deriving (Diffable, Eq, Foldable, Functor, GAlign, Generic1, Mergeable, Ord, Show, Traversable)
instance Eq1 Undefined where liftEq = genericLiftEq
instance Ord1 Undefined where liftCompare = genericLiftCompare
instance Show1 Undefined where liftShowsPrec = genericLiftShowsPrec
data ClassHeritage a = ClassHeritage { classHeritageExtendsClause :: !a, implementsClause :: !a }
deriving (Diffable, Eq, Foldable, Functor, GAlign, Generic1, Show, Traversable)
deriving (Diffable, Eq, Foldable, Functor, GAlign, Generic1, Mergeable, Ord, Show, Traversable)
instance Eq1 ClassHeritage where liftEq = genericLiftEq
instance Ord1 ClassHeritage where liftCompare = genericLiftCompare
instance Show1 ClassHeritage where liftShowsPrec = genericLiftShowsPrec
data AbstractClass a = AbstractClass { abstractClassIdentifier :: !a, abstractClassTypeParameters :: !a, classHeritage :: ![a], classBody :: ![a] }
deriving (Diffable, Eq, Foldable, Functor, GAlign, Generic1, Show, Traversable)
deriving (Diffable, Eq, Foldable, Functor, GAlign, Generic1, Mergeable, Ord, Show, Traversable)
instance Eq1 AbstractClass where liftEq = genericLiftEq
instance Ord1 AbstractClass where liftCompare = genericLiftCompare
instance Show1 AbstractClass where liftShowsPrec = genericLiftShowsPrec
data JsxElement a = JsxElement { jsxOpeningElement :: !a, jsxElements :: ![a], jsxClosingElement :: !a }
deriving (Diffable, Eq, Foldable, Functor, GAlign, Generic1, Show, Traversable)
deriving (Diffable, Eq, Foldable, Functor, GAlign, Generic1, Mergeable, Ord, Show, Traversable)
instance Eq1 JsxElement where liftEq = genericLiftEq
instance Ord1 JsxElement where liftCompare = genericLiftCompare
instance Show1 JsxElement where liftShowsPrec = genericLiftShowsPrec
newtype JsxText a = JsxText ByteString
deriving (Diffable, Eq, Foldable, Functor, GAlign, Generic1, Show, Traversable)
deriving (Diffable, Eq, Foldable, Functor, GAlign, Generic1, Mergeable, Ord, Show, Traversable)
instance Eq1 JsxText where liftEq = genericLiftEq
instance Ord1 JsxText where liftCompare = genericLiftCompare
instance Show1 JsxText where liftShowsPrec = genericLiftShowsPrec
newtype JsxExpression a = JsxExpression { jsxExpression :: a }
deriving (Diffable, Eq, Foldable, Functor, GAlign, Generic1, Show, Traversable)
deriving (Diffable, Eq, Foldable, Functor, GAlign, Generic1, Mergeable, Ord, Show, Traversable)
instance Eq1 JsxExpression where liftEq = genericLiftEq
instance Ord1 JsxExpression where liftCompare = genericLiftCompare
instance Show1 JsxExpression where liftShowsPrec = genericLiftShowsPrec
data JsxOpeningElement a = JsxOpeningElement { jsxOpeningElementIdentifier :: !a, jsxAttributes :: ![a] }
deriving (Diffable, Eq, Foldable, Functor, GAlign, Generic1, Show, Traversable)
deriving (Diffable, Eq, Foldable, Functor, GAlign, Generic1, Mergeable, Ord, Show, Traversable)
instance Eq1 JsxOpeningElement where liftEq = genericLiftEq
instance Ord1 JsxOpeningElement where liftCompare = genericLiftCompare
instance Show1 JsxOpeningElement where liftShowsPrec = genericLiftShowsPrec
newtype JsxClosingElement a = JsxClosingElement { jsxClosingElementIdentifier :: a }
deriving (Diffable, Eq, Foldable, Functor, GAlign, Generic1, Show, Traversable)
deriving (Diffable, Eq, Foldable, Functor, GAlign, Generic1, Mergeable, Ord, Show, Traversable)
instance Eq1 JsxClosingElement where liftEq = genericLiftEq
instance Ord1 JsxClosingElement where liftCompare = genericLiftCompare
instance Show1 JsxClosingElement where liftShowsPrec = genericLiftShowsPrec
data JsxSelfClosingElement a = JsxSelfClosingElement { jsxSelfClosingElementIdentifier :: !a, jsxSelfClosingElementAttributes :: ![a] }
deriving (Diffable, Eq, Foldable, Functor, GAlign, Generic1, Show, Traversable)
deriving (Diffable, Eq, Foldable, Functor, GAlign, Generic1, Mergeable, Ord, Show, Traversable)
instance Eq1 JsxSelfClosingElement where liftEq = genericLiftEq
instance Ord1 JsxSelfClosingElement where liftCompare = genericLiftCompare
instance Show1 JsxSelfClosingElement where liftShowsPrec = genericLiftShowsPrec
data JsxAttribute a = JsxAttribute { jsxAttributeTarget :: !a, jsxAttributeValue :: !a }
deriving (Diffable, Eq, Foldable, Functor, GAlign, Generic1, Show, Traversable)
deriving (Diffable, Eq, Foldable, Functor, GAlign, Generic1, Mergeable, Ord, Show, Traversable)
instance Eq1 JsxAttribute where liftEq = genericLiftEq
instance Ord1 JsxAttribute where liftCompare = genericLiftCompare
instance Show1 JsxAttribute where liftShowsPrec = genericLiftShowsPrec
newtype ImplementsClause a = ImplementsClause { implementsClauseTypes :: [a] }
deriving (Diffable, Eq, Foldable, Functor, GAlign, Generic1, Show, Traversable)
deriving (Diffable, Eq, Foldable, Functor, GAlign, Generic1, Mergeable, Ord, Show, Traversable)
instance Eq1 ImplementsClause where liftEq = genericLiftEq
instance Ord1 ImplementsClause where liftCompare = genericLiftCompare
instance Show1 ImplementsClause where liftShowsPrec = genericLiftShowsPrec
data SequenceExpression a = SequenceExpression { firstExpression :: !a, secondExpression :: !a }
deriving (Diffable, Eq, Foldable, Functor, GAlign, Generic1, Show, Traversable)
deriving (Diffable, Eq, Foldable, Functor, GAlign, Generic1, Mergeable, Ord, Show, Traversable)
instance Eq1 SequenceExpression where liftEq = genericLiftEq
instance Ord1 SequenceExpression where liftCompare = genericLiftCompare
instance Show1 SequenceExpression where liftShowsPrec = genericLiftShowsPrec
data OptionalParameter a = OptionalParameter { optionalParameterContext :: ![a], optionalParameterSubject :: !a }
deriving (Diffable, Eq, Foldable, Functor, GAlign, Generic1, Show, Traversable)
deriving (Diffable, Eq, Foldable, Functor, GAlign, Generic1, Mergeable, Ord, Show, Traversable)
instance Eq1 OptionalParameter where liftEq = genericLiftEq
instance Ord1 OptionalParameter where liftCompare = genericLiftCompare
instance Show1 OptionalParameter where liftShowsPrec = genericLiftShowsPrec
data RequiredParameter a = RequiredParameter { requiredParameterContext :: ![a], requiredParameterSubject :: !a }
deriving (Diffable, Eq, Foldable, Functor, GAlign, Generic1, Show, Traversable)
deriving (Diffable, Eq, Foldable, Functor, GAlign, Generic1, Mergeable, Ord, Show, Traversable)
instance Eq1 RequiredParameter where liftEq = genericLiftEq
instance Ord1 RequiredParameter where liftCompare = genericLiftCompare
instance Show1 RequiredParameter where liftShowsPrec = genericLiftShowsPrec
data RestParameter a = RestParameter { restParameterContext :: ![a], restParameterSubject :: !a }
deriving (Diffable, Eq, Foldable, Functor, GAlign, Generic1, Show, Traversable)
deriving (Diffable, Eq, Foldable, Functor, GAlign, Generic1, Mergeable, Ord, Show, Traversable)
instance Eq1 RestParameter where liftEq = genericLiftEq
instance Ord1 RestParameter where liftCompare = genericLiftCompare
instance Show1 RestParameter where liftShowsPrec = genericLiftShowsPrec
newtype VariableDeclaration a = VariableDeclaration { variableDeclarations :: [a] }
deriving (Diffable, Eq, Foldable, Functor, GAlign, Generic1, Show, Traversable)
deriving (Diffable, Eq, Foldable, Functor, GAlign, Generic1, Mergeable, Ord, Show, Traversable)
instance Eq1 VariableDeclaration where liftEq = genericLiftEq
instance Ord1 VariableDeclaration where liftCompare = genericLiftCompare
instance Show1 VariableDeclaration where liftShowsPrec = genericLiftShowsPrec
-- | Assignment from AST in Ruby’s grammar onto a program in TypeScript’s syntax.

29
src/Parser.hs
View File

@ -3,7 +3,6 @@ module Parser
( Parser(..)
-- Syntax parsers
, parserForLanguage
, lineByLineParser
-- À la carte parsers
, goParser
, jsonParser
@ -17,7 +16,6 @@ import qualified CMarkGFM
import Data.Functor.Classes (Eq1)
import Data.Ix
import Data.Record
import Data.Source as Source
import qualified Data.Syntax as Syntax
import Data.Syntax.Assignment
import Data.Term
@ -52,20 +50,17 @@ data Parser term where
TreeSitterParser :: Ptr TS.Language -> Parser (Term Syntax (Record DefaultFields))
-- | A parser for 'Markdown' using cmark.
MarkdownParser :: Parser (Term (TermF [] CMarkGFM.NodeType) (Node Markdown.Grammar))
-- | A parser which will parse any input 'Source' into a top-level 'Term' whose children are leaves consisting of the 'Source's lines.
LineByLineParser :: Parser (Term Syntax (Record DefaultFields))
-- | Return a 'Language'-specific 'Parser', if one exists, falling back to the 'LineByLineParser'.
parserForLanguage :: Maybe Language -> Parser (Term Syntax (Record DefaultFields))
parserForLanguage Nothing = LineByLineParser
parserForLanguage (Just language) = case language of
Go -> TreeSitterParser tree_sitter_go
JavaScript -> TreeSitterParser tree_sitter_typescript
JSON -> TreeSitterParser tree_sitter_json
JSX -> TreeSitterParser tree_sitter_typescript
Ruby -> TreeSitterParser tree_sitter_ruby
TypeScript -> TreeSitterParser tree_sitter_typescript
_ -> LineByLineParser
parserForLanguage :: Language -> Maybe (Parser (Term Syntax (Record DefaultFields)))
parserForLanguage language = case language of
Go -> Just (TreeSitterParser tree_sitter_go)
JavaScript -> Just (TreeSitterParser tree_sitter_typescript)
JSON -> Just (TreeSitterParser tree_sitter_json)
JSX -> Just (TreeSitterParser tree_sitter_typescript)
Ruby -> Just (TreeSitterParser tree_sitter_ruby)
TypeScript -> Just (TreeSitterParser tree_sitter_typescript)
_ -> Nothing
goParser :: Parser Go.Term
goParser = AssignmentParser (ASTParser tree_sitter_go) Go.assignment
@ -84,9 +79,3 @@ typescriptParser = AssignmentParser (ASTParser tree_sitter_typescript) TypeScrip
markdownParser :: Parser Markdown.Term
markdownParser = AssignmentParser MarkdownParser Markdown.assignment
-- | A fallback parser that treats a file simply as rows of strings.
lineByLineParser :: Source -> Term Syntax (Record DefaultFields)
lineByLineParser source = termIn (totalRange source :. Program :. totalSpan source :. Nil) (Indexed (zipWith toLine [1..] (sourceLineRanges source)))
where toLine line range = termIn (range :. Program :. Span (Pos line 1) (Pos line (end range)) :. Nil) (Leaf (toText (slice range source)))

9
src/Renderer.hs
View File

@ -19,18 +19,13 @@ module Renderer
import Data.Aeson (Value)
import Data.ByteString (ByteString)
import Data.Diff
import qualified Data.Map as Map
import Data.Output
import Data.Record
import Data.Term
import Data.Text (Text)
import Info (DefaultFields)
import Renderer.JSON as R
import Renderer.Patch as R
import Renderer.SExpression as R
import Renderer.TOC as R
import Syntax as S
-- | Specification of renderers for diffs, producing output in the parameter type.
data DiffRenderer output where
@ -44,8 +39,6 @@ data DiffRenderer output where
JSONDiffRenderer :: DiffRenderer (Map.Map Text Value)
-- | Render to a 'ByteString' formatted as nested s-expressions with patches indicated.
SExpressionDiffRenderer :: DiffRenderer ByteString
-- | “Render” by returning the computed 'Diff'. This renderer is not surfaced in the command-line interface, and is intended strictly for tests. Further, as it cannot render à la carte terms, it should be regarded as a (very) short-term hack until such time as we have a better idea for TOCSpec.hs.
IdentityDiffRenderer :: DiffRenderer (Maybe (Diff Syntax (Record (Maybe Declaration ': DefaultFields)) (Record (Maybe Declaration ': DefaultFields))))
deriving instance Eq (DiffRenderer output)
deriving instance Show (DiffRenderer output)
@ -58,8 +51,6 @@ data TermRenderer output where
JSONTermRenderer :: TermRenderer [Value]
-- | Render to a 'ByteString' formatted as nested s-expressions.
SExpressionTermRenderer :: TermRenderer ByteString
-- | “Render” by returning the computed 'Term'. This renderer is not surfaced in the command-line interface, and is intended strictly for tests. Further, as it cannot render à la carte terms, it should be regarded as a (very) short-term hack until such time as we have a better idea for SemanticSpec.hs.
IdentityTermRenderer :: TermRenderer (Maybe (Term Syntax (Record DefaultFields)))
deriving instance Eq (TermRenderer output)
deriving instance Show (TermRenderer output)

43
src/Semantic.hs
View File

@ -1,4 +1,4 @@
{-# LANGUAGE DataKinds, GADTs, TypeOperators #-}
{-# LANGUAGE DataKinds, DeriveAnyClass, DeriveDataTypeable, GADTs, TypeOperators #-}
module Semantic
( parseBlobs
, parseBlob
@ -7,8 +7,9 @@ module Semantic
, diffTermPair
) where
import Control.Applicative ((<|>))
import Control.Exception
import Control.Monad ((<=<))
import Control.Monad.Error.Class
import Data.Bifunctor
import Data.Blob
import Data.ByteString (ByteString)
@ -18,6 +19,7 @@ import Data.Output
import Data.Record
import Data.Syntax.Algebra
import Data.Term
import Data.Typeable
import Info
import Interpreter
import qualified Language
@ -45,7 +47,7 @@ parseBlob renderer blob@Blob{..} = case (renderer, blobLanguage) of
(ToCTermRenderer, Just Language.Python) -> parse pythonParser blob >>= decorate (declarationAlgebra blob) >>= render (renderToCTerm blob)
(ToCTermRenderer, Just Language.TypeScript) -> parse typescriptParser blob >>= decorate (declarationAlgebra blob) >>= render (renderToCTerm blob)
(ToCTermRenderer, Just Language.Ruby) -> parse rubyParser blob >>= decorate (declarationAlgebra blob) >>= render (renderToCTerm blob)
(ToCTermRenderer, _) -> parse syntaxParser blob >>= decorate (syntaxDeclarationAlgebra blob) >>= render (renderToCTerm blob)
(ToCTermRenderer, _) | Just syntaxParser <- syntaxParser -> parse syntaxParser blob >>= decorate (syntaxDeclarationAlgebra blob) >>= render (renderToCTerm blob)
(JSONTermRenderer, Just Language.Go) -> parse goParser blob >>= decorate constructorLabel >>= render (renderJSONTerm blob)
(JSONTermRenderer, Just Language.JSON) -> parse jsonParser blob >>= decorate constructorLabel >>= render (renderJSONTerm blob)
@ -53,7 +55,7 @@ parseBlob renderer blob@Blob{..} = case (renderer, blobLanguage) of
(JSONTermRenderer, Just Language.Python) -> parse pythonParser blob >>= decorate constructorLabel >>= render (renderJSONTerm blob)
(JSONTermRenderer, Just Language.TypeScript) -> parse typescriptParser blob >>= decorate constructorLabel >>= render (renderJSONTerm blob)
(JSONTermRenderer, Just Language.Ruby) -> parse rubyParser blob >>= decorate constructorLabel >>= render (renderJSONTerm blob)
(JSONTermRenderer, _) -> parse syntaxParser blob >>= decorate syntaxIdentifierAlgebra >>= render (renderJSONTerm blob)
(JSONTermRenderer, _) | Just syntaxParser <- syntaxParser -> parse syntaxParser blob >>= decorate syntaxIdentifierAlgebra >>= render (renderJSONTerm blob)
(SExpressionTermRenderer, Just Language.Go) -> parse goParser blob >>= decorate constructorLabel >>= render renderSExpressionTerm . fmap keepConstructorLabel
(SExpressionTermRenderer, Just Language.JSON) -> parse jsonParser blob >>= decorate constructorLabel >>= render renderSExpressionTerm . fmap keepConstructorLabel
@ -61,15 +63,12 @@ parseBlob renderer blob@Blob{..} = case (renderer, blobLanguage) of
(SExpressionTermRenderer, Just Language.Python) -> parse pythonParser blob >>= decorate constructorLabel >>= render renderSExpressionTerm . fmap keepConstructorLabel
(SExpressionTermRenderer, Just Language.TypeScript) -> parse typescriptParser blob >>= decorate constructorLabel >>= render renderSExpressionTerm . fmap keepConstructorLabel
(SExpressionTermRenderer, Just Language.Ruby) -> parse rubyParser blob >>= decorate constructorLabel >>= render renderSExpressionTerm . fmap keepConstructorLabel
(SExpressionTermRenderer, _) -> parse syntaxParser blob >>= render renderSExpressionTerm . fmap keepCategory
(SExpressionTermRenderer, _) | Just syntaxParser <- syntaxParser -> parse syntaxParser blob >>= render renderSExpressionTerm . fmap keepCategory
_ -> throwError (SomeException (NoParserForLanguage blobPath blobLanguage))
where syntaxParser = blobLanguage >>= parserForLanguage
(IdentityTermRenderer, Just Language.Go) -> pure Nothing
(IdentityTermRenderer, Just Language.JSON) -> pure Nothing
(IdentityTermRenderer, Just Language.Markdown) -> pure Nothing
(IdentityTermRenderer, Just Language.Python) -> pure Nothing
(IdentityTermRenderer, Just Language.TypeScript) -> pure Nothing
(IdentityTermRenderer, _) -> Just <$> parse syntaxParser blob
where syntaxParser = parserForLanguage blobLanguage
data NoParserForLanguage = NoParserForLanguage FilePath (Maybe Language.Language)
deriving (Eq, Exception, Ord, Show, Typeable)
diffBlobPairs :: Output output => DiffRenderer output -> [Both Blob] -> Task ByteString
@ -80,14 +79,14 @@ diffBlobPair :: DiffRenderer output -> Both Blob -> Task output
diffBlobPair renderer blobs = case (renderer, effectiveLanguage) of
(OldToCDiffRenderer, Just Language.Markdown) -> run (\ blob -> parse markdownParser blob >>= decorate (markupSectionAlgebra blob)) diffTerms (renderToCDiff blobs)
(OldToCDiffRenderer, Just Language.Python) -> run (\ blob -> parse pythonParser blob >>= decorate (declarationAlgebra blob)) diffTerms (renderToCDiff blobs)
(OldToCDiffRenderer, _) -> run (\ blob -> parse syntaxParser blob >>= decorate (syntaxDeclarationAlgebra blob)) diffSyntaxTerms (renderToCDiff blobs)
(OldToCDiffRenderer, _) | Just syntaxParser <- syntaxParser -> run (\ blob -> parse syntaxParser blob >>= decorate (syntaxDeclarationAlgebra blob)) diffSyntaxTerms (renderToCDiff blobs)
(ToCDiffRenderer, Just Language.Go) -> run (\ blob -> parse goParser blob >>= decorate (declarationAlgebra blob)) diffTerms (renderToCDiff blobs)
(ToCDiffRenderer, Just Language.Markdown) -> run (\ blob -> parse markdownParser blob >>= decorate (markupSectionAlgebra blob)) diffTerms (renderToCDiff blobs)
(ToCDiffRenderer, Just Language.Python) -> run (\ blob -> parse pythonParser blob >>= decorate (declarationAlgebra blob)) diffTerms (renderToCDiff blobs)
(ToCDiffRenderer, Just Language.Ruby) -> run (\ blob -> parse rubyParser blob >>= decorate (declarationAlgebra blob)) diffTerms (renderToCDiff blobs)
(ToCDiffRenderer, Just Language.TypeScript) -> run (\ blob -> parse typescriptParser blob >>= decorate (declarationAlgebra blob)) diffTerms (renderToCDiff blobs)
(ToCDiffRenderer, _) -> run (\ blob -> parse syntaxParser blob >>= decorate (syntaxDeclarationAlgebra blob)) diffSyntaxTerms (renderToCDiff blobs)
(ToCDiffRenderer, _) | Just syntaxParser <- syntaxParser -> run (\ blob -> parse syntaxParser blob >>= decorate (syntaxDeclarationAlgebra blob)) diffSyntaxTerms (renderToCDiff blobs)
(JSONDiffRenderer, Just Language.Go) -> run (parse goParser) diffTerms (renderJSONDiff blobs)
(JSONDiffRenderer, Just Language.JSON) -> run (parse jsonParser) diffTerms (renderJSONDiff blobs)
@ -95,7 +94,7 @@ diffBlobPair renderer blobs = case (renderer, effectiveLanguage) of
(JSONDiffRenderer, Just Language.Python) -> run (parse pythonParser) diffTerms (renderJSONDiff blobs)
(JSONDiffRenderer, Just Language.Ruby) -> run (parse rubyParser) diffTerms (renderJSONDiff blobs)
(JSONDiffRenderer, Just Language.TypeScript) -> run (parse typescriptParser) diffTerms (renderJSONDiff blobs)
(JSONDiffRenderer, _) -> run (decorate syntaxIdentifierAlgebra <=< parse syntaxParser) diffSyntaxTerms (renderJSONDiff blobs)
(JSONDiffRenderer, _) | Just syntaxParser <- syntaxParser -> run (decorate syntaxIdentifierAlgebra <=< parse syntaxParser) diffSyntaxTerms (renderJSONDiff blobs)
(PatchDiffRenderer, Just Language.Go) -> run (parse goParser) diffTerms (renderPatch blobs)
(PatchDiffRenderer, Just Language.JSON) -> run (parse jsonParser) diffTerms (renderPatch blobs)
@ -103,7 +102,7 @@ diffBlobPair renderer blobs = case (renderer, effectiveLanguage) of
(PatchDiffRenderer, Just Language.Python) -> run (parse pythonParser) diffTerms (renderPatch blobs)
(PatchDiffRenderer, Just Language.Ruby) -> run (parse rubyParser) diffTerms (renderPatch blobs)
(PatchDiffRenderer, Just Language.TypeScript) -> run (parse typescriptParser) diffTerms (renderPatch blobs)
(PatchDiffRenderer, _) -> run (parse syntaxParser) diffSyntaxTerms (renderPatch blobs)
(PatchDiffRenderer, _) | Just syntaxParser <- syntaxParser -> run (parse syntaxParser) diffSyntaxTerms (renderPatch blobs)
(SExpressionDiffRenderer, Just Language.Go) -> run (decorate constructorLabel <=< parse goParser) diffTerms (renderSExpressionDiff . bimap keepConstructorLabel keepConstructorLabel)
(SExpressionDiffRenderer, Just Language.JSON) -> run (decorate constructorLabel <=< parse jsonParser) diffTerms (renderSExpressionDiff . bimap keepConstructorLabel keepConstructorLabel)
@ -111,11 +110,13 @@ diffBlobPair renderer blobs = case (renderer, effectiveLanguage) of
(SExpressionDiffRenderer, Just Language.Python) -> run (decorate constructorLabel <=< parse pythonParser) diffTerms (renderSExpressionDiff . bimap keepConstructorLabel keepConstructorLabel)
(SExpressionDiffRenderer, Just Language.Ruby) -> run (decorate constructorLabel <=< parse rubyParser) diffTerms (renderSExpressionDiff . bimap keepConstructorLabel keepConstructorLabel)
(SExpressionDiffRenderer, Just Language.TypeScript) -> run (decorate constructorLabel <=< parse typescriptParser) diffTerms (renderSExpressionDiff . bimap keepConstructorLabel keepConstructorLabel)
(SExpressionDiffRenderer, _) -> run (parse syntaxParser) diffSyntaxTerms (renderSExpressionDiff . bimap keepCategory keepCategory)
(IdentityDiffRenderer, _) -> run (\ blob -> parse syntaxParser blob >>= decorate (syntaxDeclarationAlgebra blob)) diffSyntaxTerms Just
where effectiveLanguage = runBothWith (<|>) (blobLanguage <$> blobs)
syntaxParser = parserForLanguage effectiveLanguage
(SExpressionDiffRenderer, _) | Just syntaxParser <- syntaxParser -> run (parse syntaxParser) diffSyntaxTerms (renderSExpressionDiff . bimap keepCategory keepCategory)
_ -> throwError (SomeException (NoParserForLanguage effectivePath effectiveLanguage))
where (effectivePath, effectiveLanguage) = case runJoin blobs of
(Blob { blobLanguage = Just lang, blobPath = path }, _) -> (path, Just lang)
(_, Blob { blobLanguage = Just lang, blobPath = path }) -> (path, Just lang)
(Blob { blobPath = path }, _) -> (path, Nothing)
syntaxParser = effectiveLanguage >>= parserForLanguage
run :: Functor syntax => (Blob -> Task (Term syntax ann)) -> (Term syntax ann -> Term syntax ann -> Diff syntax ann ann) -> (Diff syntax ann ann -> output) -> Task output
run parse diff renderer = distributeFor blobs parse >>= runBothWith (diffTermPair blobs diff) >>= render renderer

1
src/Semantic/Task.hs
View File

@ -217,7 +217,6 @@ runParser Options{..} blob@Blob{..} = go
pure term
TreeSitterParser tslanguage -> logTiming "ts parse" $ liftIO (treeSitterParser tslanguage blob)
MarkdownParser -> logTiming "cmark parse" $ pure (cmarkParser blobSource)
LineByLineParser -> logTiming "line-by-line parse" $ pure (lineByLineParser blobSource)
blobFields = ("path", blobPath) : maybe [] (pure . (,) "language" . show) blobLanguage
errors :: (Syntax.Error :< fs, Apply Foldable fs, Apply Functor fs) => Term (Union fs) (Record Assignment.Location) -> [Error.Error String]
errors = cata $ \ (In a syntax) -> case syntax of

7
src/Semantic/Util.hs
View File

@ -49,10 +49,3 @@ diffWithParser :: (HasField fields Data.Span.Span,
diffWithParser parser = run (\ blob -> parse parser blob >>= decorate (declarationAlgebra blob))
where
run parse sourceBlobs = distributeFor sourceBlobs parse >>= runBothWith (diffTermPair sourceBlobs diffTerms)
-- diffRecursively :: (Declaration.Method :< fs, Declaration.Function :< fs, Apply Eq1 fs, Apply GAlign fs, Apply Show1 fs, Apply Foldable fs, Apply Functor fs, Apply Traversable fs, Apply Diffable fs)
-- => Term (Union fs) (Record fields1)
-- -> Term (Union fs) (Record fields2)
-- -> Diff (Union fs) (Record fields1) (Record fields2)
-- diffRecursively = decoratingWith constructorNameAndConstantFields constructorNameAndConstantFields (diffTermsWith algorithmForTerms comparableByConstructor equivalentTerms)

44
test/Data/Functor/Classes/Ord/Generic/Spec.hs Normal file
View File

@ -0,0 +1,44 @@
module Data.Functor.Classes.Ord.Generic.Spec where
import Data.Functor.Classes.Eq.Generic
import Data.Functor.Classes.Ord.Generic
import Data.Functor.Listable
import GHC.Generics
import Test.Hspec
import Test.Hspec.LeanCheck
spec :: Spec
spec = parallel $ do
describe "genericLiftCompare" $ do
prop "equivalent to derived compare for product types" $
\ a b -> genericLiftCompare compare a b `shouldBe` compare a (b :: Product Int)
prop "equivalent to derived compare for sum types" $
\ a b -> genericLiftCompare compare a b `shouldBe` compare a (b :: Sum Int)
prop "equivalent to derived compare for recursive types" $
\ a b -> genericLiftCompare compare a b `shouldBe` compare a (b :: Tree Int)
data Product a = Product a a a
deriving (Eq, Generic1, Ord, Show)
instance Listable a => Listable (Product a) where
tiers = cons3 Product
data Sum a = Sum1 a | Sum2 a | Sum3 a
deriving (Eq, Generic1, Ord, Show)
instance Listable a => Listable (Sum a) where
tiers = cons1 Sum1 \/ cons1 Sum2 \/ cons1 Sum3
data Tree a = Leaf a | Branch [Tree a]
deriving (Eq, Generic1, Ord, Show)
instance Listable a => Listable (Tree a) where
tiers = cons1 Leaf \/ cons1 Branch
instance Eq1 Tree where liftEq = genericLiftEq
instance Ord1 Tree where liftCompare = genericLiftCompare

12
test/SemanticSpec.hs
View File

@ -11,19 +11,17 @@ import Renderer
import Semantic
import Semantic.Task
import Syntax
import System.Exit
import Test.Hspec hiding (shouldBe, shouldNotBe, shouldThrow, errorCall)
import Test.Hspec.Expectations.Pretty
spec :: Spec
spec = parallel $ do
describe "parseBlob" $ do
it "parses in the specified language" $ do
Just term <- runTask $ parseBlob IdentityTermRenderer methodsBlob
void term `shouldBe` Term (() `In` Indexed [ Term (() `In` Method [] (Term (() `In` Leaf "foo")) Nothing [] []) ])
it "parses line by line if not given a language" $ do
Just term <- runTask $ parseBlob IdentityTermRenderer methodsBlob { blobLanguage = Nothing }
void term `shouldBe` Term (() `In` Indexed [ Term (() `In` Leaf "def foo\n"), Term (() `In` Leaf "end\n"), Term (() `In` Leaf "") ])
it "throws if not given a language" $ do
runTask (parseBlob SExpressionTermRenderer methodsBlob { blobLanguage = Nothing }) `shouldThrow` (\ code -> case code of
ExitFailure 1 -> True
_ -> False)
it "renders with the specified renderer" $ do
output <- runTask $ parseBlob SExpressionTermRenderer methodsBlob

2
test/Spec.hs
View File

@ -2,6 +2,7 @@ module Main where
import qualified AlignmentSpec
import qualified CommandSpec
import qualified Data.Functor.Classes.Ord.Generic.Spec
import qualified Data.Mergeable.Spec
import qualified Data.RandomWalkSimilarity.Spec
import qualified Data.Syntax.Assignment.Spec
@ -22,6 +23,7 @@ main = hspec $ do
parallel $ do
describe "Alignment" AlignmentSpec.spec
describe "Command" CommandSpec.spec
describe "Data.Functor.Classes.Ord.Generic" Data.Functor.Classes.Ord.Generic.Spec.spec
describe "Data.Mergeable" Data.Mergeable.Spec.spec
describe "Data.RandomWalkSimilarity" Data.RandomWalkSimilarity.Spec.spec
describe "Data.Syntax.Assignment" Data.Syntax.Assignment.Spec.spec

22
test/TOCSpec.hs
View File

@ -2,7 +2,7 @@
{-# LANGUAGE DataKinds, TypeOperators #-}
module TOCSpec where
import Category as C
import Category as C hiding (Go)
import Data.Aeson
import Data.Bifunctor
import Data.Blob
@ -20,7 +20,7 @@ import Data.Source
import Data.Term
import Data.Text (Text)
import Data.These
import Info
import Info hiding (Go)
import Interpreter
import Language
import Prelude hiding (readFile)
@ -31,7 +31,7 @@ import Semantic
import Semantic.Task
import Semantic.Util
import SpecHelpers
import Syntax as S
import Syntax as S hiding (Go)
import Test.Hspec (Spec, describe, it, parallel)
import Test.Hspec.Expectations.Pretty
import Test.Hspec.LeanCheck
@ -69,11 +69,10 @@ spec = parallel $ do
it "summarizes changed methods" $ do
sourceBlobs <- blobsForPaths (both "ruby/methods.A.rb" "ruby/methods.B.rb")
Just diff <- runTask (diffBlobPair IdentityDiffRenderer sourceBlobs)
diff <- runTask $ diffWithParser rubyParser sourceBlobs
diffTOC diff `shouldBe`
[ JSONSummary "Method" "self.foo" (sourceSpanBetween (1, 1) (2, 4)) "added"
, JSONSummary "Method" "bar" (sourceSpanBetween (4, 1) (6, 4)) "modified"
, JSONSummary "Method" "baz" (sourceSpanBetween (4, 1) (5, 4)) "removed" ]
[ JSONSummary "Method" "self.foo" (sourceSpanBetween (1, 1) (2, 4)) "modified"
, JSONSummary "Method" "bar" (sourceSpanBetween (4, 1) (6, 4)) "modified" ]
it "dedupes changes in same parent method" $ do
sourceBlobs <- blobsForPaths (both "javascript/duplicate-parent.A.js" "javascript/duplicate-parent.B.js")
@ -89,25 +88,26 @@ spec = parallel $ do
it "summarizes Go methods with receivers with special formatting" $ do
sourceBlobs <- blobsForPaths (both "go/method-with-receiver.A.go" "go/method-with-receiver.B.go")
Just diff <- runTask (diffBlobPair IdentityDiffRenderer sourceBlobs)
let Just goParser = parserForLanguage Go
diff <- runTask $ distributeFor sourceBlobs (\ blob -> parse goParser blob >>= decorate (syntaxDeclarationAlgebra blob)) >>= runBothWith (diffTermPair sourceBlobs diffSyntaxTerms)
diffTOC diff `shouldBe`
[ JSONSummary "Method" "(*apiClient) CheckAuth" (sourceSpanBetween (3,1) (3,101)) "added" ]
it "summarizes Ruby methods that start with two identifiers" $ do
sourceBlobs <- blobsForPaths (both "ruby/method-starts-with-two-identifiers.A.rb" "ruby/method-starts-with-two-identifiers.B.rb")
Just diff <- runTask (diffBlobPair IdentityDiffRenderer sourceBlobs)
diff <- runTask $ diffWithParser rubyParser sourceBlobs
diffTOC diff `shouldBe`
[ JSONSummary "Method" "foo" (sourceSpanBetween (1, 1) (4, 4)) "modified" ]
it "handles unicode characters in file" $ do
sourceBlobs <- blobsForPaths (both "ruby/unicode.A.rb" "ruby/unicode.B.rb")
Just diff <- runTask (diffBlobPair IdentityDiffRenderer sourceBlobs)
diff <- runTask $ diffWithParser rubyParser sourceBlobs
diffTOC diff `shouldBe`
[ JSONSummary "Method" "foo" (sourceSpanBetween (6, 1) (7, 4)) "added" ]
it "properly slices source blob that starts with a newline and has multi-byte chars" $ do
sourceBlobs <- blobsForPaths (both "javascript/starts-with-newline.js" "javascript/starts-with-newline.js")
Just diff <- runTask (diffBlobPair IdentityDiffRenderer sourceBlobs)
diff <- runTask $ diffWithParser rubyParser sourceBlobs
diffTOC diff `shouldBe` []
prop "inserts of methods and functions are summarized" $

17
test/fixtures/ruby/hash.diffA-B.txt vendored
View File

@ -20,12 +20,17 @@
{-(Integer)-})-})
{-(Hash)-}
{-(Hash
{-(KeyValue
{-(Identifier)-}
{-(Integer)-})-}
{-(KeyValue
{-(TextElement)-}
{-(Integer)-})-}
{-(Context
{-(Comment)-}
{-(KeyValue
{-(Identifier)-}
{-(Integer)-})-})-}
{-(Context
{-(Comment)-}
{-(Comment)-}
{-(KeyValue
{-(TextElement)-}
{-(Integer)-})-})-}
{-(Context
{-(Comment)-}
{-(Empty)-})-})-}

17
test/fixtures/ruby/hash.diffB-A.txt vendored
View File

@ -20,12 +20,17 @@
{+(Integer)+})+})
{+(Hash)+}
{+(Hash
{+(KeyValue
{+(Identifier)+}
{+(Integer)+})+}
{+(KeyValue
{+(TextElement)+}
{+(Integer)+})+}
{+(Context
{+(Comment)+}
{+(KeyValue
{+(Identifier)+}
{+(Integer)+})+})+}
{+(Context
{+(Comment)+}
{+(Comment)+}
{+(KeyValue
{+(TextElement)+}
{+(Integer)+})+})+}
{+(Context
{+(Comment)+}
{+(Empty)+})+})+}

17
test/fixtures/ruby/hash.parseA.txt vendored
View File

@ -14,12 +14,17 @@
(Integer)))
(Hash)
(Hash
(KeyValue
(Identifier)
(Integer))
(KeyValue
(TextElement)
(Integer))
(Context
(Comment)
(KeyValue
(Identifier)
(Integer)))
(Context
(Comment)
(Comment)
(KeyValue
(TextElement)
(Integer)))
(Context
(Comment)
(Empty)))