1
1
mirror of https://github.com/github/semantic.git synced 2024-12-25 16:02:43 +03:00

Merge branch 'master' into markdown

This commit is contained in:
Rob Rix 2016-09-13 10:35:28 -04:00
commit b4e6e1dbb8
24 changed files with 484 additions and 334 deletions

View File

@ -1,5 +1,5 @@
name: semantic-diff
version: 0.1.0.0
version: 0.1.0
synopsis: Initial project template from stack
description: Please see README.md
homepage: http://github.com/github/semantic-diff#readme
@ -15,6 +15,7 @@ library
hs-source-dirs: src
exposed-modules: Algorithm
, Alignment
, Arguments
, Category
, Data.Align.Generic
, Data.Bifunctor.Join.Arbitrary
@ -30,6 +31,8 @@ library
, Info
, Interpreter
, Language
, Language.C
, Language.JavaScript
, Parser
, Patch
, Patch.Arbitrary
@ -49,6 +52,7 @@ library
, TreeSitter
, DiffSummary
, Prologue
, Paths_semantic_diff
build-depends: aeson
, base >= 4.8 && < 5
, bifunctors

View File

@ -38,15 +38,15 @@ numberedRows = countUp (both 1 1)
nextLineNumbers from row = modifyJoin (fromThese identity identity) (succ <$ row) <*> from
-- | Determine whether a line contains any patches.
hasChanges :: SplitDiff leaf annotation -> Bool
hasChanges :: (Prologue.Foldable f, Functor f) => SplitDiff f annotation -> Bool
hasChanges = or . (True <$)
-- | Align a Diff into a list of Join These SplitDiffs representing the (possibly blank) lines on either side.
alignDiff :: HasField fields Range => Both (Source Char) -> Diff leaf (Record fields) -> [Join These (SplitDiff leaf (Record fields))]
alignDiff :: HasField fields Range => Both (Source Char) -> SyntaxDiff leaf fields -> [Join These (SplitSyntaxDiff leaf fields)]
alignDiff sources diff = iter (alignSyntax (runBothWith ((Join .) . These)) wrap getRange sources) (alignPatch sources <$> diff)
-- | Align the contents of a patch into a list of lines on the corresponding side(s) of the diff.
alignPatch :: forall fields leaf. HasField fields Range => Both (Source Char) -> Patch (Term leaf (Record fields)) -> [Join These (SplitDiff leaf (Record fields))]
alignPatch :: forall fields leaf. HasField fields Range => Both (Source Char) -> Patch (SyntaxTerm leaf fields) -> [Join These (SplitSyntaxDiff leaf fields)]
alignPatch sources patch = case patch of
Delete term -> fmap (pure . SplitDelete) <$> alignSyntax' this (fst sources) term
Insert term -> fmap (pure . SplitInsert) <$> alignSyntax' that (snd sources) term
@ -54,13 +54,13 @@ alignPatch sources patch = case patch of
(alignSyntax' this (fst sources) term1)
(alignSyntax' that (snd sources) term2)
where getRange = characterRange . extract
alignSyntax' :: (forall a. Identity a -> Join These a) -> Source Char -> Term leaf (Record fields) -> [Join These (Term leaf (Record fields))]
alignSyntax' :: (forall a. Identity a -> Join These a) -> Source Char -> SyntaxTerm leaf fields -> [Join These (SyntaxTerm leaf fields)]
alignSyntax' side source term = hylo (alignSyntax side cofree getRange (Identity source)) runCofree (Identity <$> term)
this = Join . This . runIdentity
that = Join . That . runIdentity
-- | The Applicative instance f is either Identity or Both. Identity is for Terms in Patches, Both is for Diffs in unchanged portions of the diff.
alignSyntax :: (Applicative f, HasField fields Range) => (forall a. f a -> Join These a) -> (CofreeF (Syntax leaf) (Record fields) term -> term) -> (term -> Range) -> f (Source Char) -> CofreeF (Syntax leaf) (f (Record fields)) [Join These term] -> [Join These term]
alignSyntax :: (Applicative f, HasField fields Range) => (forall a. f a -> Join These a) -> (SyntaxTermF leaf fields term -> term) -> (term -> Range) -> f (Source Char) -> TermF (Syntax leaf) (f (Record fields)) [Join These term] -> [Join These term]
alignSyntax toJoinThese toNode getRange sources (infos :< syntax) = catMaybes $ case syntax of
Leaf s -> wrapInBranch (const (Leaf s)) <$> alignBranch getRange [] bothRanges
Syntax.Comment a -> wrapInBranch (const (Syntax.Comment a)) <$> alignBranch getRange [] bothRanges

23
src/Arguments.hs Normal file
View File

@ -0,0 +1,23 @@
module Arguments (Arguments(..), args) where
import Data.Functor.Both
import qualified Prelude as P
import Prelude
import qualified Renderer as R
-- | The command line arguments to the application.
data Arguments = Arguments {
format :: R.Format,
maybeShas :: Both (Maybe P.String),
maybeTimeout :: Maybe Float,
output :: Maybe FilePath,
filepaths :: [FilePath] }
deriving (Show)
args :: String -> String -> [String] -> R.Format -> Arguments
args sha1 sha2 filePaths format = Arguments { format = format
, maybeShas = Just <$> both sha1 sha2
, filepaths = filePaths
, maybeTimeout = Just 10.0
, output = Nothing
}

View File

@ -6,35 +6,39 @@ import Prologue
import Data.Functor.Foldable as Foldable
import Data.Functor.Both as Both
import Data.Mergeable
import Data.Record
import Patch
import Syntax
import Term
-- | An annotated series of patches of terms.
type DiffF leaf annotation = FreeF (CofreeF (Syntax leaf) (Both annotation)) (Patch (Term leaf annotation))
type Diff a annotation = Free (CofreeF (Syntax a) (Both annotation)) (Patch (Term a annotation))
type DiffF f annotation = FreeF (TermF f (Both annotation)) (Patch (Term f annotation))
type Diff f annotation = Free (TermF f (Both annotation)) (Patch (Term f annotation))
type SyntaxDiff leaf fields = Diff (Syntax leaf) (Record fields)
type instance Base (Free f a) = FreeF f a
instance Functor f => Foldable.Foldable (Free f a) where project = runFree
instance Functor f => Foldable.Unfoldable (Free f a) where embed = free
diffSum :: (Patch (Term a annotation) -> Int) -> Diff a annotation -> Int
diffSum :: (Prologue.Foldable f, Functor f) => (Patch (Term f annotation) -> Int) -> Diff f annotation -> Int
diffSum patchCost diff = sum $ fmap patchCost diff
-- | The sum of the node count of the diffs patches.
diffCost :: Diff a annotation -> Int
diffCost :: (Prologue.Foldable f, Functor f) => Diff f annotation -> Int
diffCost = diffSum $ patchSum termSize
-- | Merge a diff using a function to provide the Term (in Maybe, to simplify recovery of the before/after state) for every Patch.
mergeMaybe :: (Patch (Term leaf annotation) -> Maybe (Term leaf annotation)) -> Diff leaf annotation -> Maybe (Term leaf annotation)
mergeMaybe :: (Functor f, Mergeable f) => (Patch (Term f annotation) -> Maybe (Term f annotation)) -> Diff f annotation -> Maybe (Term f annotation)
mergeMaybe transform = iter algebra . fmap transform
where algebra :: CofreeF (Syntax leaf) (Both annotation) (Maybe (Term leaf annotation)) -> Maybe (Term leaf annotation)
where algebra :: Mergeable f => TermF f (Both annotation) (Maybe (Term f annotation)) -> Maybe (Term f annotation)
algebra (annotations :< syntax) = cofree . (Both.fst annotations :<) <$> sequenceAlt syntax
-- | Recover the before state of a diff.
beforeTerm :: Diff leaf annotation -> Maybe (Term leaf annotation)
beforeTerm :: (Functor f, Mergeable f) => Diff f annotation -> Maybe (Term f annotation)
beforeTerm = mergeMaybe before
-- | Recover the after state of a diff.
afterTerm :: Diff leaf annotation -> Maybe (Term leaf annotation)
afterTerm :: (Functor f, Mergeable f) => Diff f annotation -> Maybe (Term f annotation)
afterTerm = mergeMaybe after

View File

@ -3,11 +3,13 @@ module Diff.Arbitrary where
import Diff
import Data.Bifunctor.Join
import Data.Bifunctor.Join.Arbitrary ()
import Data.Functor.Both
import Data.Functor.Foldable (unfold)
import Patch
import Patch.Arbitrary ()
import Syntax
import Prologue
import Term
import Term.Arbitrary
import Test.QuickCheck hiding (Fixed)
@ -16,11 +18,11 @@ data ArbitraryDiff leaf annotation
| ArbitraryPure (Patch (ArbitraryTerm leaf annotation))
deriving (Show, Eq, Generic)
unArbitraryDiff :: ArbitraryDiff leaf annotation -> FreeF (CofreeF (Syntax leaf) (Join (,) annotation)) (Patch (ArbitraryTerm leaf annotation)) (ArbitraryDiff leaf annotation)
unArbitraryDiff :: ArbitraryDiff leaf annotation -> FreeF (TermF (Syntax leaf) (Both annotation)) (Patch (ArbitraryTerm leaf annotation)) (ArbitraryDiff leaf annotation)
unArbitraryDiff (ArbitraryFree a s) = Free (a :< s)
unArbitraryDiff (ArbitraryPure p) = Pure p
toDiff :: ArbitraryDiff leaf annotation -> Diff leaf annotation
toDiff :: ArbitraryDiff leaf annotation -> Diff (Syntax leaf) annotation
toDiff = fmap (fmap toTerm) . unfold unArbitraryDiff
diffOfSize :: (Arbitrary leaf, Arbitrary annotation) => Int -> Gen (ArbitraryDiff leaf annotation)

View File

@ -22,6 +22,25 @@ import qualified Text.PrettyPrint.Leijen.Text as P
import SourceSpan
import Source
data Identifiable a = Identifiable a | Unidentifiable a
isIdentifiable :: (HasCategory leaf, HasField fields Category, HasField fields Range) => SyntaxTerm leaf fields -> Bool
isIdentifiable term =
case unwrap term of
S.FunctionCall _ _ -> True
S.Function{} -> True
S.Assignment{} -> True
S.MathAssignment{} -> True
S.VarAssignment{} -> True
S.SubscriptAccess{} -> True
S.Class _ _ _ -> True
S.Method _ _ _ -> True
S.Leaf _ -> True
_ -> False
identifiable :: (HasCategory leaf, HasField fields Category, HasField fields Range) => SyntaxTerm leaf fields -> Identifiable (SyntaxTerm leaf fields)
identifiable term = if isIdentifiable term then Identifiable term else Unidentifiable term
data DiffInfo = LeafInfo { categoryName :: Text, termName :: Text }
| BranchInfo { branches :: [ DiffInfo ], categoryName :: Text, branchType :: Branch }
| ErrorInfo { errorSpan :: SourceSpan, termName :: Text }
@ -35,7 +54,7 @@ data DiffSummary a = DiffSummary {
} deriving (Eq, Functor, Show, Generic)
-- Returns a list of diff summary texts given two source blobs and a diff.
diffSummaries :: (HasCategory leaf, HasField fields Category, HasField fields Range) => Both SourceBlob -> Diff leaf (Record fields) -> [Either Text Text]
diffSummaries :: (HasCategory leaf, HasField fields Category, HasField fields Range) => Both SourceBlob -> SyntaxDiff leaf fields -> [Either Text Text]
diffSummaries blobs diff = summaryToTexts =<< diffToDiffSummaries (source <$> blobs) diff
-- Takes a 'DiffSummary' and returns a list of summary texts representing the LeafInfos
@ -44,7 +63,7 @@ summaryToTexts :: DiffSummary DiffInfo -> [Either Text Text]
summaryToTexts DiffSummary{..} = runJoin . fmap (show . (P.<> maybeParentContext parentAnnotation)) <$> (Join <$> summaries patch)
-- Returns a list of 'DiffSummary' given two source blobs and a diff.
diffToDiffSummaries :: (HasCategory leaf, HasField fields Category, HasField fields Range) => Both (Source Char) -> Diff leaf (Record fields) -> [DiffSummary DiffInfo]
diffToDiffSummaries :: (HasCategory leaf, HasField fields Category, HasField fields Range) => Both (Source Char) -> SyntaxDiff leaf fields -> [DiffSummary DiffInfo]
diffToDiffSummaries sources = para $ \diff ->
let diff' = free (Prologue.fst <$> diff)
annotateWithCategory :: [(Diff leaf (Record fields), [DiffSummary DiffInfo])] -> [DiffSummary DiffInfo]
@ -85,7 +104,7 @@ toLeafInfos BranchInfo{..} = toLeafInfos =<< branches
toLeafInfos err@ErrorInfo{} = pure (pretty err)
-- Returns a text representing a specific term given a source and a term.
toTermName :: (HasCategory leaf, HasField fields Category, HasField fields Range) => Source Char -> Term leaf (Record fields) -> Text
toTermName :: forall leaf fields. (HasCategory leaf, HasField fields Category, HasField fields Range) => Source Char -> SyntaxTerm leaf fields -> Text
toTermName source term = case unwrap term of
S.AnonymousFunction _ _ -> "anonymous"
S.Fixed children -> fromMaybe "branch" $ (toCategoryName . category) . extract <$> head children
@ -95,13 +114,13 @@ toTermName source term = case unwrap term of
(S.MemberAccess{}, S.AnonymousFunction{..}) -> toTermName' identifier
(_, _) -> toTermName' identifier <> toTermName' value
S.Function identifier _ _ -> toTermName' identifier
S.FunctionCall i _ -> toTermName' i
S.FunctionCall i args -> toTermName' i <> "(" <> (intercalate ", " (toArgName <$> args)) <> ")"
S.MemberAccess base property -> case (unwrap base, unwrap property) of
(S.FunctionCall{}, S.FunctionCall{}) -> toTermName' base <> "()." <> toTermName' property <> "()"
(S.FunctionCall{}, _) -> toTermName' base <> "()." <> toTermName' property
(_, S.FunctionCall{}) -> toTermName' base <> "." <> toTermName' property <> "()"
(_, _) -> toTermName' base <> "." <> toTermName' property
S.MethodCall targetId methodId _ -> toTermName' targetId <> sep <> toTermName' methodId <> "()"
S.MethodCall targetId methodId methodParams -> toTermName' targetId <> sep <> toTermName' methodId <> "(" <> (intercalate ", " (toArgName <$> methodParams)) <> ")"
where sep = case unwrap targetId of
S.FunctionCall{} -> "()."
_ -> "."
@ -143,6 +162,10 @@ toTermName source term = case unwrap term of
termNameFromSource term = termNameFromRange (range term)
termNameFromRange range = toText $ Source.slice range source
range = characterRange . extract
toArgName :: (HasCategory leaf, HasField fields Category, HasField fields Range) => SyntaxTerm leaf fields -> Text
toArgName arg = case identifiable arg of
Identifiable arg -> toTermName' arg
Unidentifiable _ -> "..."
maybeParentContext :: Maybe (Category, Text) -> Doc
maybeParentContext = maybe "" (\annotation ->
@ -151,13 +174,12 @@ maybeParentContext = maybe "" (\annotation ->
toDoc :: Text -> Doc
toDoc = string . toS
termToDiffInfo :: (HasCategory leaf, HasField fields Category, HasField fields Range) => Source Char -> Term leaf (Record fields) -> DiffInfo
termToDiffInfo :: (HasCategory leaf, HasField fields Category, HasField fields Range) => Source Char -> SyntaxTerm leaf fields -> DiffInfo
termToDiffInfo blob term = case unwrap term of
Leaf _ -> LeafInfo (toCategoryName term) (toTermName' term)
S.AnonymousFunction _ _ -> LeafInfo (toCategoryName term) ("anonymous")
S.Indexed children -> BranchInfo (termToDiffInfo' <$> children) (toCategoryName term) BIndexed
S.Fixed children -> BranchInfo (termToDiffInfo' <$> children) (toCategoryName term) BFixed
S.FunctionCall identifier _ -> LeafInfo (toCategoryName term) (toTermName' identifier)
S.Ternary ternaryCondition _ -> LeafInfo (toCategoryName term) (toTermName' ternaryCondition)
S.Function identifier _ _ -> LeafInfo (toCategoryName term) (toTermName' identifier)
S.Assignment identifier _ -> LeafInfo (toCategoryName term) (toTermName' identifier)
@ -171,22 +193,11 @@ termToDiffInfo blob term = case unwrap term of
where toTermName' = toTermName blob
termToDiffInfo' = termToDiffInfo blob
prependSummary :: (HasCategory leaf, HasField fields Range, HasField fields Category) => Source Char -> Term leaf (Record fields) -> DiffSummary DiffInfo -> DiffSummary DiffInfo
prependSummary source term summary = if (isNothing $ parentAnnotation summary) && hasIdentifier term
then summary { parentAnnotation = Just (category $ extract term, toTermName source term) }
else summary
where hasIdentifier term = case unwrap term of
S.FunctionCall{} -> True
S.Function _ _ _ -> True
S.Assignment{} -> True
S.MathAssignment{} -> True
S.MemberAccess{} -> True
S.MethodCall{} -> True
S.VarAssignment{} -> True
S.SubscriptAccess{} -> True
S.Class{} -> True
S.Method{} -> True
_ -> False
prependSummary :: (HasCategory leaf, HasField fields Range, HasField fields Category) => Source Char -> SyntaxTerm leaf fields -> DiffSummary DiffInfo -> DiffSummary DiffInfo
prependSummary source term summary =
case (parentAnnotation summary, identifiable term) of
(Nothing, Identifiable term) -> summary { parentAnnotation = Just (category . extract $ term, toTermName source term) }
(_, _) -> summary
isBranchInfo :: DiffInfo -> Bool
isBranchInfo info = case info of
@ -259,7 +270,7 @@ instance HasCategory Category where
C.CommaOperator -> "comma operator"
C.Empty -> "empty statement"
instance (HasCategory leaf, HasField fields Category) => HasCategory (Term leaf (Record fields)) where
instance (HasCategory leaf, HasField fields Category) => HasCategory (SyntaxTerm leaf fields) where
toCategoryName = toCategoryName . category . extract
instance Arbitrary Branch where

View File

@ -119,7 +119,7 @@ parserForFilepath path blob = decorateTerm termCostDecorator <$> do
pure $! breakDownLeavesByWord (source blob) parsed
-- | Replace every string leaf with leaves of the words in the string.
breakDownLeavesByWord :: (HasField fields Category, HasField fields Range) => Source Char -> Term Text (Record fields) -> Term Text (Record fields)
breakDownLeavesByWord :: (HasField fields Category, HasField fields Range) => Source Char -> Term (Syntax Text) (Record fields) -> Term (Syntax Text) (Record fields)
breakDownLeavesByWord source = cata replaceIn
where
replaceIn (info :< syntax) = cofree $ info :< syntax'
@ -132,7 +132,7 @@ breakDownLeavesByWord source = cata replaceIn
-- Some Category constructors should retain their original structure, and not be sliced
-- into words. This Set represents those Category constructors for which we want to
-- preserve the original Syntax.
preserveSyntax = Set.fromList [Regex, Category.Comment]
preserveSyntax = Set.fromList [Regex, Category.Comment, Category.TemplateString]
-- | Transcode a file to a unicode source.
transcode :: B1.ByteString -> IO (Source Char)
@ -159,11 +159,11 @@ termCostDecorator :: (Prologue.Foldable f, Functor f) => TermDecorator f a Cost
termCostDecorator c = 1 + sum (cost <$> tailF c)
-- | Determine whether two terms are comparable based on the equality of their categories.
compareCategoryEq :: HasField fields Category => Term leaf (Record fields) -> Term leaf (Record fields) -> Bool
compareCategoryEq :: Functor f => HasField fields Category => Term f (Record fields) -> Term f (Record fields) -> Bool
compareCategoryEq = (==) `on` category . extract
-- | The sum of the node count of the diffs patches.
diffCostWithCachedTermCosts :: HasField fields Cost => Diff leaf (Record fields) -> Int
diffCostWithCachedTermCosts :: Functor f => HasField fields Cost => Diff f (Record fields) -> Int
diffCostWithCachedTermCosts diff = unCost $ case runFree diff of
Free (info :< _) -> sum (cost <$> info)
Pure patch -> sum (cost . extract <$> patch)

View File

@ -19,23 +19,23 @@ import Syntax as S
import Term
-- | Returns whether two terms are comparable
type Comparable leaf annotation = Term leaf annotation -> Term leaf annotation -> Bool
type Comparable f annotation = Term f annotation -> Term f annotation -> Bool
-- | Constructs a diff from the CofreeF containing its annotation and syntax. This function has the opportunity to, for example, cache properties in the annotation.
type DiffConstructor leaf annotation = CofreeF (Syntax leaf) (Both annotation) (Diff leaf annotation) -> Diff leaf annotation
type DiffConstructor f annotation = TermF f (Both annotation) (Diff f annotation) -> Diff f annotation
-- | Diff two terms recursively, given functions characterizing the diffing.
diffTerms :: (Eq leaf, Eq (Record fields), HasField fields Category, HasField fields (Vector.Vector Double))
=> DiffConstructor leaf (Record fields) -- ^ A function to wrap up & possibly annotate every produced diff.
-> Comparable leaf (Record fields) -- ^ A function to determine whether or not two terms should even be compared.
-> SES.Cost (Diff leaf (Record fields)) -- ^ A function to compute the cost of a given diff node.
-> Term leaf (Record fields) -- ^ A term representing the old state.
-> Term leaf (Record fields) -- ^ A term representing the new state.
-> Diff leaf (Record fields)
=> DiffConstructor (Syntax leaf) (Record fields) -- ^ A function to wrap up & possibly annotate every produced diff.
-> Comparable (Syntax leaf) (Record fields) -- ^ A function to determine whether or not two terms should even be compared.
-> SES.Cost (SyntaxDiff leaf fields) -- ^ A function to compute the cost of a given diff node.
-> SyntaxTerm leaf fields -- ^ A term representing the old state.
-> SyntaxTerm leaf fields -- ^ A term representing the new state.
-> SyntaxDiff leaf fields
diffTerms construct comparable cost a b = fromMaybe (replacing a b) $ diffComparableTerms construct comparable cost a b
-- | Diff two terms recursively, given functions characterizing the diffing. If the terms are incomparable, returns 'Nothing'.
diffComparableTerms :: (Eq leaf, Eq (Record fields), HasField fields Category, HasField fields (Vector.Vector Double)) => DiffConstructor leaf (Record fields) -> Comparable leaf (Record fields) -> SES.Cost (Diff leaf (Record fields)) -> Term leaf (Record fields) -> Term leaf (Record fields) -> Maybe (Diff leaf (Record fields))
diffComparableTerms :: (Eq leaf, Eq (Record fields), HasField fields Category, HasField fields (Vector.Vector Double)) => DiffConstructor (Syntax leaf) (Record fields) -> Comparable (Syntax leaf) (Record fields) -> SES.Cost (SyntaxDiff leaf fields) -> SyntaxTerm leaf fields -> SyntaxTerm leaf fields -> Maybe (SyntaxDiff leaf fields)
diffComparableTerms construct comparable cost = recur
where recur a b
| (category <$> a) == (category <$> b) = hylo construct runCofree <$> zipTerms a b
@ -43,7 +43,7 @@ diffComparableTerms construct comparable cost = recur
| otherwise = Nothing
-- | Construct an algorithm to diff a pair of terms.
algorithmWithTerms :: (TermF leaf (Both a) diff -> diff) -> Term leaf a -> Term leaf a -> Algorithm (Term leaf a) diff diff
algorithmWithTerms :: (TermF (Syntax leaf) (Both a) diff -> diff) -> Term (Syntax leaf) a -> Term (Syntax leaf) a -> Algorithm (Term (Syntax leaf) a) diff diff
algorithmWithTerms construct t1 t2 = case (unwrap t1, unwrap t2) of
(Indexed a, Indexed b) -> branch Indexed a b
(S.FunctionCall identifierA argsA, S.FunctionCall identifierB argsB) -> do

View File

@ -1,6 +1,13 @@
{-# LANGUAGE DataKinds #-}
module Language where
import Data.Record
import Info
import Prologue
import Source
import SourceSpan
import qualified Syntax as S
import Term
-- | A programming language.
data Language =
@ -32,3 +39,17 @@ languageForType mediaType = case mediaType of
".md" -> Just Markdown
".rb" -> Just Ruby
_ -> Nothing
termConstructor
:: Source Char -- ^ The source that the term occurs within.
-> IO SourceSpan -- ^ The span that the term occupies. This is passed in 'IO' to guarantee some access constraints & encourage its use only when needed (improving performance).
-> Text -- ^ The name of the production for this node.
-> Range -- ^ The character range that the term occupies.
-> [Term (S.Syntax Text) (Record '[Range, Category])] -- ^ The child nodes of the term.
-> IO (Term (S.Syntax Text) (Record '[Range, Category])) -- ^ The resulting term, in IO.
termConstructor source sourceSpan name range children =
withDefaultInfo <$> case (name, children) of
("ERROR", _) -> S.Error <$> sourceSpan <*> pure children
(_, []) -> S.Leaf <$> pure (toText $ slice range source)
_ -> S.Indexed <$> pure children
where withDefaultInfo syntax = cofree ((range .: Other name .: RNil) :< syntax)

29
src/Language/C.hs Normal file
View File

@ -0,0 +1,29 @@
{-# LANGUAGE DataKinds #-}
module Language.C where
import Data.Record
import Info
import Prologue
import Source
import SourceSpan
import Syntax
import qualified Syntax as S
import Term
termConstructor
:: Source Char -- ^ The source that the term occurs within.
-> IO SourceSpan -- ^ The span that the term occupies. This is passed in 'IO' to guarantee some access constraints & encourage its use only when needed (improving performance).
-> Text -- ^ The name of the production for this node.
-> Range -- ^ The character range that the term occupies.
-> [Term (Syntax Text) (Record '[Range, Category])] -- ^ The child nodes of the term.
-> IO (Term (Syntax Text) (Record '[Range, Category])) -- ^ The resulting term, in IO.
termConstructor source sourceSpan name range children
| name == "ERROR" = sourceSpan >>= withDefaultInfo . (`S.Error` children)
| otherwise = withDefaultInfo $ case (name, children) of
(_, []) -> S.Leaf . toText $ slice range source
_ -> S.Indexed children
where withDefaultInfo syntax = pure $! cofree ((range .: categoryForCProductionName name .: RNil) :< syntax)
categoryForCProductionName :: Text -> Category
categoryForCProductionName name = case name of
_ -> Other name

151
src/Language/JavaScript.hs Normal file
View File

@ -0,0 +1,151 @@
{-# LANGUAGE DataKinds #-}
module Language.JavaScript where
import Data.Record
import Info
import Prologue
import Source
import SourceSpan
import qualified Syntax as S
import Term
operators :: [Text]
operators = [ "op", "bool_op", "math_op", "delete_op", "type_op", "void_op", "rel_op", "bitwise_op" ]
functions :: [Text]
functions = [ "arrow_function", "generator_function", "function" ]
forStatements :: [Text]
forStatements = [ "for_statement", "for_of_statement", "for_in_statement" ]
termConstructor
:: Source Char -- ^ The source that the term occurs within.
-> IO SourceSpan -- ^ The span that the term occupies. This is passed in 'IO' to guarantee some access constraints & encourage its use only when needed (improving performance).
-> Text -- ^ The name of the production for this node.
-> Range -- ^ The character range that the term occupies.
-> [Term (S.Syntax Text) (Record '[Range, Category])] -- ^ The child nodes of the term.
-> IO (Term (S.Syntax Text) (Record '[Range, Category])) -- ^ The resulting term, in IO.
termConstructor source sourceSpan name range children
| name == "ERROR" = sourceSpan >>= withDefaultInfo . (`S.Error` children)
| otherwise = withDefaultInfo $ case (name, children) of
("return_statement", _) -> S.Return (listToMaybe children)
("assignment", [ identifier, value ]) -> S.Assignment identifier value
("math_assignment", [ identifier, value ]) -> S.MathAssignment identifier value
("member_access", [ base, property ]) -> S.MemberAccess base property
("subscript_access", [ base, element ]) -> S.SubscriptAccess base element
("comma_op", [ a, b ]) -> case unwrap b of
S.Indexed rest -> S.Indexed $ a : rest
_ -> S.Indexed children
("function_call", _) -> case runCofree <$> children of
[ (_ :< S.MemberAccess{..}), (_ :< S.Args args) ] -> S.MethodCall memberId property args
[ (_ :< S.MemberAccess{..}) ] -> S.MethodCall memberId property []
[ function, (_ :< S.Args args) ] -> S.FunctionCall (cofree function) args
(x:xs) -> S.FunctionCall (cofree x) (cofree <$> xs)
_ -> S.Indexed children
("ternary", (condition:cases)) -> S.Ternary condition cases
("arguments", _) -> S.Args children
("var_assignment", [ x, y ]) -> S.VarAssignment x y
("var_declaration", _) -> S.Indexed $ toVarDecl <$> children
("switch_statement", (expr:rest)) -> S.Switch expr rest
("case", [ expr, body ]) -> S.Case expr body
("object", _) -> S.Object $ foldMap toTuple children
("pair", _) -> S.Fixed children
("if_statement", [ expr, clause1, clause2 ]) -> S.If expr clause1 (Just clause2)
("if_statement", [ expr, clause ]) -> S.If expr clause Nothing
("while_statement", [ expr, body ]) -> S.While expr body
("do_statement", [ expr, body ]) -> S.DoWhile expr body
("throw_statement", [ expr ]) -> S.Throw expr
("new_expression", [ expr ]) -> S.Constructor expr
("try_statement", [ body ]) -> S.Try body Nothing Nothing
("try_statement", [ body, catch ]) | Catch <- category (extract catch) -> S.Try body (Just catch) Nothing
("try_statement", [ body, finally ]) | Finally <- category (extract finally) -> S.Try body Nothing (Just finally)
("try_statement", [ body, catch, finally ])
| Catch <- category (extract catch)
, Finally <- category (extract finally) -> S.Try body (Just catch) (Just finally)
("array", _) -> S.Array children
("method_definition", [ identifier, params, exprs ]) -> S.Method identifier (toList (unwrap params)) (toList (unwrap exprs))
("method_definition", [ identifier, exprs ]) -> S.Method identifier [] (toList (unwrap exprs))
("class", [ identifier, superclass, definitions ]) -> S.Class identifier (Just superclass) (toList (unwrap definitions))
("class", [ identifier, definitions ]) -> S.Class identifier Nothing (toList (unwrap definitions))
_ | name `elem` forStatements, Just (exprs, body) <- unsnoc children -> S.For exprs body
_ | name `elem` operators -> S.Operator children
_ | name `elem` functions -> case children of
[ body ] -> S.AnonymousFunction Nothing body
[ params, body ] -> S.AnonymousFunction (Just params) body
[ id, params, body ] -> S.Function id (Just params) body
_ -> S.Indexed children
(_, []) -> S.Leaf . toText $ slice range source
_ -> S.Indexed children
where withDefaultInfo syntax@(S.MethodCall _ _ _) = pure $! cofree ((range .: MethodCall .: RNil) :< syntax)
withDefaultInfo syntax = pure $! cofree ((range .: categoryForJavaScriptProductionName name .: RNil) :< syntax)
categoryForJavaScriptProductionName :: Text -> Category
categoryForJavaScriptProductionName name = case name of
"object" -> Object
"expression_statement" -> ExpressionStatements
"this_expression" -> Identifier
"null" -> Identifier
"undefined" -> Identifier
"arrow_function" -> Function
"generator_function" -> Function
"math_op" -> BinaryOperator -- bitwise operator, e.g. +, -, *, /.
"bool_op" -> BinaryOperator -- boolean operator, e.g. ||, &&.
"comma_op" -> CommaOperator -- comma operator, e.g. expr1, expr2.
"delete_op" -> Operator -- delete operator, e.g. delete x[2].
"type_op" -> Operator -- type operator, e.g. typeof Object.
"void_op" -> Operator -- void operator, e.g. void 2.
"for_in_statement" -> For
"for_of_statement" -> For
"new_expression" -> Constructor
"class" -> Class
"catch" -> Catch
"finally" -> Finally
"if_statement" -> If
"empty_statement" -> Empty
"program" -> Program
"ERROR" -> Error
"function_call" -> FunctionCall
"pair" -> Pair
"string" -> StringLiteral
"integer" -> IntegerLiteral
"symbol" -> SymbolLiteral
"array" -> ArrayLiteral
"function" -> Function
"identifier" -> Identifier
"formal_parameters" -> Params
"arguments" -> Args
"statement_block" -> ExpressionStatements
"assignment" -> Assignment
"member_access" -> MemberAccess
"op" -> Operator
"subscript_access" -> SubscriptAccess
"regex" -> Regex
"template_string" -> TemplateString
"var_assignment" -> VarAssignment
"var_declaration" -> VarDecl
"switch_statement" -> Switch
"math_assignment" -> MathAssignment
"case" -> Case
"true" -> Boolean
"false" -> Boolean
"ternary" -> Ternary
"for_statement" -> For
"while_statement" -> While
"do_statement" -> DoWhile
"return_statement" -> Return
"throw_statement" -> Throw
"try_statement" -> Try
"method_definition" -> Method
"comment" -> Comment
"bitwise_op" -> BitwiseOperator
"rel_op" -> RelationalOperator
_ -> Other name
toVarDecl :: (HasField fields Category) => Term (S.Syntax Text) (Record fields) -> Term (S.Syntax Text) (Record fields)
toVarDecl child = cofree $ (setCategory (extract child) VarDecl :< S.VarDecl child)
toTuple :: Term (S.Syntax Text) (Record fields) -> [Term (S.Syntax Text) (Record fields)]
toTuple child | S.Indexed [key,value] <- unwrap child = [cofree (extract child :< S.Pair key value)]
toTuple child | S.Fixed [key,value] <- unwrap child = [cofree (extract child :< S.Pair key value)]
toTuple child | S.Leaf c <- unwrap child = [cofree (extract child :< S.Comment c)]
toTuple child = pure child

View File

@ -1,148 +1,9 @@
{-# LANGUAGE ScopedTypeVariables #-}
module Parser where
import Prologue hiding (Constructor)
import Data.Record
import Data.Text (pack)
import Category as C
import Info
import qualified Syntax as S
import Term
import qualified Data.Set as Set
import Source hiding (uncons)
import SourceSpan
import Prologue
import Source
-- | A function that takes a source blob and returns an annotated AST.
-- | The return is in the IO monad because some of the parsers are written in C
-- | and aren't pure.
type Parser f a = SourceBlob -> IO (Cofree f a)
-- | Whether a category is an Operator Category
isOperator :: Category -> Bool
isOperator = flip Set.member (Set.fromList [ Operator, BinaryOperator, BitwiseOperator, RelationalOperator ])
-- | Construct a term given source, the span covered, the annotation for the term, and its children.
--
-- This is typically called during parsing, building terms up leaf-to-root.
termConstructor :: forall fields. (Show (Record fields), HasField fields Category, HasField fields Range)
=> Source Char -- ^ The source that the term occurs within.
-> IO SourceSpan -- ^ The span that the term occupies. This is passed in 'IO' to guarantee some access constraints & encourage its use only when needed (improving performance).
-> Record fields -- ^ The annotation for the term.
-> [Term Text (Record fields)] -- ^ The child nodes of the term.
-> IO (Term Text (Record fields)) -- ^ The resulting term, in IO.
termConstructor source sourceSpan info = fmap cofree . construct
where
withDefaultInfo syntax = pure (info :< syntax)
errorWith children = do
sourceSpan' <- sourceSpan
withDefaultInfo (S.Error sourceSpan' children)
construct :: (Show (Record fields), HasField fields Category, HasField fields Range) => [Term Text (Record fields)] -> IO (CofreeF (S.Syntax Text) (Record fields) (Term Text (Record fields)))
construct [] = case category info of
Return -> withDefaultInfo $ S.Return Nothing -- Map empty return statements to Return Nothing
_ -> withDefaultInfo . S.Leaf . pack . toString $ slice (characterRange info) source
construct children | Return == category info =
withDefaultInfo $ S.Return (listToMaybe children)
construct children | Assignment == category info = case children of
(identifier:value:[]) -> withDefaultInfo $ S.Assignment identifier value
children -> errorWith children
construct children | MathAssignment == category info = case children of
(identifier:value:[]) -> withDefaultInfo $ S.MathAssignment identifier value
children -> errorWith children
construct children | MemberAccess == category info = case children of
(base:property:[]) -> withDefaultInfo $ S.MemberAccess base property
children -> errorWith children
construct children | SubscriptAccess == category info = case children of
(base:element:[]) -> withDefaultInfo $ S.SubscriptAccess base element
_ -> errorWith children
construct children | isOperator (category info) = withDefaultInfo $ S.Operator children
construct children | CommaOperator == category info = withDefaultInfo $ case children of
[child, rest] | S.Indexed cs <- unwrap rest -> S.Indexed $ child : toList cs
_ -> S.Indexed children
construct children | Function == category info = case children of
(body:[]) -> withDefaultInfo $ S.AnonymousFunction Nothing body
(params:body:[]) | (info :< _) <- runCofree params, Params == category info ->
withDefaultInfo $ S.AnonymousFunction (Just params) body
(id:body:[]) | (info :< _) <- runCofree id, Identifier == category info ->
withDefaultInfo $ S.Function id Nothing body
(id:params:body:[]) | (info :< _) <- runCofree id, Identifier == category info ->
withDefaultInfo $ S.Function id (Just params) body
_ -> errorWith children
construct children | FunctionCall == category info = case runCofree <$> children of
[ (_ :< S.MemberAccess{..}), (_ :< S.Args args) ] ->
pure $! setCategory info MethodCall :< S.MethodCall memberId property args
[ (_ :< S.MemberAccess{..}) ] ->
pure $! setCategory info MethodCall :< S.MethodCall memberId property []
(x:xs) ->
withDefaultInfo $ S.FunctionCall (cofree x) (cofree <$> xs)
_ -> errorWith children
construct children | Ternary == category info = case children of
(condition:cases) -> withDefaultInfo $ S.Ternary condition cases
_ -> errorWith children
construct children | Args == category info = withDefaultInfo $ S.Args children
construct children | VarAssignment == category info
, [x, y] <- children = withDefaultInfo $ S.VarAssignment x y
construct children | VarDecl == category info = withDefaultInfo . S.Indexed $ toVarDecl <$> children
where
toVarDecl :: (HasField fields Category) => Term Text (Record fields) -> Term Text (Record fields)
toVarDecl child = cofree $ (setCategory (extract child) VarDecl :< S.VarDecl child)
construct children | Switch == category info, (expr:_) <- children =
withDefaultInfo $ S.Switch expr children
construct children | Case == category info, [expr, body] <- children =
withDefaultInfo $ S.Case expr body
construct children | Object == category info = withDefaultInfo . S.Object $ foldMap toTuple children
where
toTuple :: Term Text (Record fields) -> [Term Text (Record fields)]
toTuple child | S.Indexed [key,value] <- unwrap child = [cofree (extract child :< S.Pair key value)]
toTuple child | S.Fixed [key,value] <- unwrap child = [cofree (extract child :< S.Pair key value)]
toTuple child | S.Leaf c <- unwrap child = [cofree (extract child :< S.Comment c)]
toTuple child = pure child
construct children | Pair == (category info) = withDefaultInfo $ S.Fixed children
construct children | C.Error == category info =
errorWith children
construct children | If == category info, Just (expr, clauses) <- uncons children =
case clauses of
[clause1, clause2] -> withDefaultInfo $ S.If expr clause1 (Just clause2)
[clause] -> withDefaultInfo $ S.If expr clause Nothing
_ -> errorWith children
construct children | For == category info, Just (exprs, body) <- unsnoc children =
withDefaultInfo $ S.For exprs body
construct children | While == category info, [expr, body] <- children =
withDefaultInfo $ S.While expr body
construct children | DoWhile == category info, [expr, body] <- children =
withDefaultInfo $ S.DoWhile expr body
construct children | Throw == category info, [expr] <- children =
withDefaultInfo $ S.Throw expr
construct children | Constructor == category info, [expr] <- children =
withDefaultInfo $ S.Constructor expr
construct children | Try == category info = case children of
[body] -> withDefaultInfo $ S.Try body Nothing Nothing
[body, catch] | Catch <- category (extract catch) -> withDefaultInfo $ S.Try body (Just catch) Nothing
[body, finally] | Finally <- category (extract finally) -> withDefaultInfo $ S.Try body Nothing (Just finally)
[body, catch, finally] | Catch <- category (extract catch),
Finally <- category (extract finally) ->
withDefaultInfo $ S.Try body (Just catch) (Just finally)
_ -> errorWith children
construct children | ArrayLiteral == category info =
withDefaultInfo $ S.Array children
construct children | Method == category info = case children of
[identifier, params, exprs] |
Params == category (extract params),
S.Indexed params' <- unwrap params ->
withDefaultInfo $ S.Method identifier params' (toList (unwrap exprs))
[identifier, exprs] ->
withDefaultInfo $ S.Method identifier mempty (toList (unwrap exprs))
_ -> errorWith children
construct children | Class == category info = case children of
[identifier, superclass, definitions] ->
withDefaultInfo $ S.Class identifier (Just superclass) (toList (unwrap definitions))
[identifier, definitions] ->
withDefaultInfo $ S.Class identifier Nothing (toList (unwrap definitions))
_ -> errorWith children
construct children =
withDefaultInfo $ S.Indexed children

View File

@ -1,16 +1,17 @@
module Renderer (Renderer, DiffArguments(..), Output(..), concatOutputs, toSummaryKey, Format(..)) where
import Prologue
import Data.Functor.Both
import Diff
import Source (SourceBlob)
import Data.Text as T (intercalate)
import Data.Aeson (Value, toEncoding)
import Data.Aeson.Encoding (encodingToLazyByteString)
import Data.Functor.Both
import Data.Map as Map hiding (null)
import Data.Text as T (intercalate)
import Diff
import Prologue
import Source (SourceBlob)
import Syntax
-- | A function that will render a diff, given the two source blobs.
type Renderer annotation = Both SourceBlob -> Diff Text annotation -> Output
type Renderer annotation = Both SourceBlob -> Diff (Syntax Text) annotation -> Output
data DiffArguments = DiffArguments { format :: Format, output :: Maybe FilePath, outputPath :: FilePath }
deriving (Show)

View File

@ -32,7 +32,7 @@ json blobs diff = JSONOutput $ Map.fromList [
-- | A numbered 'a'.
newtype NumberedLine a = NumberedLine (Int, a)
instance (HasField fields Category, HasField fields Range) => ToJSON (NumberedLine (SplitDiff leaf (Record fields))) where
instance (HasField fields Category, HasField fields Range) => ToJSON (NumberedLine (SplitSyntaxDiff leaf fields)) where
toJSON (NumberedLine (n, a)) = object (lineFields n a (getRange a))
toEncoding (NumberedLine (n, a)) = pairs $ mconcat (lineFields n a (getRange a))
instance ToJSON Category where
@ -46,18 +46,18 @@ instance ToJSON a => ToJSON (Join These a) where
toEncoding = foldable
instance ToJSON a => ToJSON (Join (,) a) where
toJSON (Join (a, b)) = A.Array . Vector.fromList $ toJSON <$> [ a, b ]
instance (HasField fields Category, HasField fields Range) => ToJSON (SplitDiff leaf (Record fields)) where
instance (HasField fields Category, HasField fields Range) => ToJSON (SplitSyntaxDiff leaf fields) where
toJSON splitDiff = case runFree splitDiff of
(Free (info :< syntax)) -> object (termFields info syntax)
(Pure patch) -> object (patchFields patch)
toEncoding splitDiff = case runFree splitDiff of
(Free (info :< syntax)) -> pairs $ mconcat (termFields info syntax)
(Pure patch) -> pairs $ mconcat (patchFields patch)
instance (HasField fields Category, HasField fields Range) => ToJSON (Term leaf (Record fields)) where
instance (HasField fields Category, HasField fields Range) => ToJSON (SyntaxTerm leaf fields) where
toJSON term | (info :< syntax) <- runCofree term = object (termFields info syntax)
toEncoding term | (info :< syntax) <- runCofree term = pairs $ mconcat (termFields info syntax)
lineFields :: (HasField fields Category, HasField fields Range) => KeyValue kv => Int -> SplitDiff leaf (Record fields) -> Range -> [kv]
lineFields :: (HasField fields Category, HasField fields Range) => KeyValue kv => Int -> SplitSyntaxDiff leaf fields -> Range -> [kv]
lineFields n term range = [ "number" .= n
, "terms" .= [ term ]
, "range" .= range
@ -102,7 +102,7 @@ termFields info syntax = "range" .= characterRange info : "category" .= category
S.Method identifier params definitions -> [ "methodIdentifier" .= identifier ] <> [ "params" .= params ] <> [ "definitions" .= definitions ]
where childrenFields c = [ "children" .= c ]
patchFields :: (KeyValue kv, HasField fields Category, HasField fields Range) => SplitPatch (Term leaf (Record fields)) -> [kv]
patchFields :: (KeyValue kv, HasField fields Category, HasField fields Range) => SplitPatch (SyntaxTerm leaf fields) -> [kv]
patchFields patch = case patch of
SplitInsert term -> fields "insert" term
SplitDelete term -> fields "delete" term

View File

@ -53,7 +53,7 @@ rowIncrement :: Join These a -> Both (Sum Int)
rowIncrement = Join . fromThese (Sum 0) (Sum 0) . runJoin . (Sum 1 <$)
-- | Given the before and after sources, render a hunk to a string.
showHunk :: HasField fields Range => Both SourceBlob -> Hunk (SplitDiff a (Record fields)) -> String
showHunk :: Functor f => HasField fields Range => Both SourceBlob -> Hunk (SplitDiff f (Record fields)) -> String
showHunk blobs hunk = maybeOffsetHeader <>
concat (showChange sources <$> changes hunk) <>
showLines (snd sources) ' ' (maybeSnd . runJoin <$> trailingContext hunk)
@ -66,18 +66,18 @@ showHunk blobs hunk = maybeOffsetHeader <>
(offsetA, offsetB) = runJoin . fmap (show . getSum) $ offset hunk
-- | Given the before and after sources, render a change to a string.
showChange :: HasField fields Range => Both (Source Char) -> Change (SplitDiff a (Record fields)) -> String
showChange :: Functor f => HasField fields Range => Both (Source Char) -> Change (SplitDiff f (Record fields)) -> String
showChange sources change = showLines (snd sources) ' ' (maybeSnd . runJoin <$> context change) <> deleted <> inserted
where (deleted, inserted) = runJoin $ pure showLines <*> sources <*> both '-' '+' <*> Join (unzip (fromThese Nothing Nothing . runJoin . fmap Just <$> contents change))
-- | Given a source, render a set of lines to a string with a prefix.
showLines :: HasField fields Range => Source Char -> Char -> [Maybe (SplitDiff leaf (Record fields))] -> String
showLines :: Functor f => HasField fields Range => Source Char -> Char -> [Maybe (SplitDiff f (Record fields))] -> String
showLines source prefix lines = fromMaybe "" . mconcat $ fmap prepend . showLine source <$> lines
where prepend "" = ""
prepend source = prefix : source
-- | Given a source, render a line to a string.
showLine :: HasField fields Range => Source Char -> Maybe (SplitDiff leaf (Record fields)) -> Maybe String
showLine :: Functor f => HasField fields Range => Source Char -> Maybe (SplitDiff f (Record fields)) -> Maybe String
showLine source line | Just line <- line = Just . toString . (`slice` source) $ getRange line
| otherwise = Nothing
@ -116,7 +116,7 @@ emptyHunk :: Hunk (SplitDiff a annotation)
emptyHunk = Hunk { offset = mempty, changes = [], trailingContext = [] }
-- | Render a diff as a series of hunks.
hunks :: HasField fields Range => Diff a (Record fields) -> Both SourceBlob -> [Hunk (SplitDiff a (Record fields))]
hunks :: HasField fields Range => SyntaxDiff leaf fields -> Both SourceBlob -> [Hunk (SplitSyntaxDiff leaf fields)]
hunks _ blobs | sources <- source <$> blobs
, sourcesEqual <- runBothWith (==) sources
, sourcesNull <- runBothWith (&&) (null <$> sources)
@ -126,14 +126,14 @@ hunks diff blobs = hunksInRows (pure 1) $ alignDiff (source <$> blobs) diff
-- | Given beginning line numbers, turn rows in a split diff into hunks in a
-- | patch.
hunksInRows :: Both (Sum Int) -> [Join These (SplitDiff a annotation)] -> [Hunk (SplitDiff a annotation)]
hunksInRows :: (Prologue.Foldable f, Functor f) => Both (Sum Int) -> [Join These (SplitDiff f annotation)] -> [Hunk (SplitDiff f annotation)]
hunksInRows start rows = case nextHunk start rows of
Nothing -> []
Just (hunk, rest) -> hunk : hunksInRows (offset hunk <> hunkLength hunk) rest
-- | Given beginning line numbers, return the next hunk and the remaining rows
-- | of the split diff.
nextHunk :: Both (Sum Int) -> [Join These (SplitDiff a annotation)] -> Maybe (Hunk (SplitDiff a annotation), [Join These (SplitDiff a annotation)])
nextHunk :: (Prologue.Foldable f, Functor f) => Both (Sum Int) -> [Join These (SplitDiff f annotation)] -> Maybe (Hunk (SplitDiff f annotation), [Join These (SplitDiff f annotation)])
nextHunk start rows = case nextChange start rows of
Nothing -> Nothing
Just (offset, change, rest) -> let (changes, rest') = contiguousChanges rest in Just (Hunk offset (change : changes) $ take 3 rest', drop 3 rest')
@ -145,7 +145,7 @@ nextHunk start rows = case nextChange start rows of
-- | Given beginning line numbers, return the number of lines to the next
-- | the next change, and the remaining rows of the split diff.
nextChange :: Both (Sum Int) -> [Join These (SplitDiff a annotation)] -> Maybe (Both (Sum Int), Change (SplitDiff a annotation), [Join These (SplitDiff a annotation)])
nextChange :: (Prologue.Foldable f, Functor f) => Both (Sum Int) -> [Join These (SplitDiff f annotation)] -> Maybe (Both (Sum Int), Change (SplitDiff f annotation), [Join These (SplitDiff f annotation)])
nextChange start rows = case changeIncludingContext leadingContext afterLeadingContext of
Nothing -> Nothing
Just (change, afterChanges) -> Just (start <> mconcat (rowIncrement <$> skippedContext), change, afterChanges)
@ -155,12 +155,12 @@ nextChange start rows = case changeIncludingContext leadingContext afterLeadingC
-- | Return a Change with the given context and the rows from the begginning of
-- | the given rows that have changes, or Nothing if the first row has no
-- | changes.
changeIncludingContext :: [Join These (SplitDiff a annotation)] -> [Join These (SplitDiff a annotation)] -> Maybe (Change (SplitDiff a annotation), [Join These (SplitDiff a annotation)])
changeIncludingContext :: (Prologue.Foldable f, Functor f) => [Join These (SplitDiff f annotation)] -> [Join These (SplitDiff f annotation)] -> Maybe (Change (SplitDiff f annotation), [Join These (SplitDiff f annotation)])
changeIncludingContext leadingContext rows = case changes of
[] -> Nothing
_ -> Just (Change leadingContext changes, afterChanges)
where (changes, afterChanges) = span rowHasChanges rows
-- | Whether a row has changes on either side.
rowHasChanges :: Join These (SplitDiff a annotation) -> Bool
rowHasChanges :: (Prologue.Foldable f, Functor f) => Join These (SplitDiff f annotation) -> Bool
rowHasChanges row = or (hasChanges <$> row)

View File

@ -77,6 +77,7 @@ styleName category = "category-" <> case category of
C.Method -> "method"
C.If -> "if_statement"
C.Empty -> "empty_statement"
C.CommaOperator -> "comma_operator"
Other string -> string
-- | Pick the class name for a split patch.
@ -141,15 +142,15 @@ wrapIn f p = f p
-- Instances
instance (ToMarkup f, HasField fields Category, HasField fields Cost, HasField fields Range) => ToMarkup (Renderable (CofreeF (Syntax leaf) (Record fields) (f, Range))) where
instance (ToMarkup f, HasField fields Category, HasField fields Cost, HasField fields Range) => ToMarkup (Renderable (SyntaxTermF leaf fields (f, Range))) where
toMarkup (Renderable source (info :< syntax)) = classifyMarkup (category info) $ case syntax of
Leaf _ -> span . string . toString $ slice (characterRange info) source
_ -> ul . mconcat $ wrapIn li <$> contentElements source (characterRange info) (toList syntax)
instance (HasField fields Category, HasField fields Cost, HasField fields Range) => ToMarkup (Renderable (Term leaf (Record fields))) where
instance (HasField fields Category, HasField fields Cost, HasField fields Range) => ToMarkup (Renderable (SyntaxTerm leaf fields)) where
toMarkup (Renderable source term) = Prologue.fst $ cata (\ t -> (toMarkup $ Renderable source t, characterRange (headF t))) term
instance (HasField fields Category, HasField fields Cost, HasField fields Range) => ToMarkup (Renderable (SplitDiff leaf (Record fields))) where
instance (HasField fields Category, HasField fields Cost, HasField fields Range) => ToMarkup (Renderable (SplitSyntaxDiff leaf fields)) where
toMarkup (Renderable source diff) = Prologue.fst . iter (\ t -> (toMarkup $ Renderable source t, characterRange (headF t))) $ toMarkupAndRange <$> diff
where toMarkupAndRange patch = let term@(info :< _) = runCofree $ getSplitTerm patch in
((div ! patchAttribute patch `withCostAttribute` cost info) . toMarkup $ Renderable source (cofree term), characterRange info)

View File

@ -4,7 +4,7 @@ import Data.Record
import Info
import Prologue
import Syntax
import Term (Term)
import Term (Term, TermF)
-- | A patch to only one side of a diff.
data SplitPatch a = SplitInsert a | SplitDelete a | SplitReplace a
@ -17,10 +17,11 @@ getSplitTerm (SplitDelete a) = a
getSplitTerm (SplitReplace a) = a
-- | Get the range of a SplitDiff.
getRange :: HasField fields Range => SplitDiff leaf (Record fields) -> Range
getRange :: Functor f => HasField fields Range => SplitDiff f (Record fields) -> Range
getRange diff = characterRange $ case runFree diff of
Free annotated -> headF annotated
Pure patch -> extract (getSplitTerm patch)
-- | A diff with only one sides annotations.
type SplitDiff leaf annotation = Free (CofreeF (Syntax leaf) annotation) (SplitPatch (Term leaf annotation))
type SplitDiff f annotation = Free (TermF f annotation) (SplitPatch (Term f annotation))
type SplitSyntaxDiff leaf fields = SplitDiff (Syntax leaf) (Record fields)

View File

@ -6,36 +6,40 @@ import Prologue
import Data.Align.Generic
import Data.Functor.Foldable as Foldable
import Data.Functor.Both
import Data.Record
import Data.These
import Syntax
-- | An annotated node (Syntax) in an abstract syntax tree.
type TermF a annotation = CofreeF (Syntax a) annotation
type Term a annotation = Cofree (Syntax a) annotation
type TermF = CofreeF
type Term f = Cofree f
type instance Base (Cofree f a) = CofreeF f a
instance Functor f => Foldable.Foldable (Cofree f a) where project = runCofree
instance Functor f => Foldable.Unfoldable (Cofree f a) where embed = cofree
type SyntaxTermF leaf fields = TermF (Syntax leaf) (Record fields)
type SyntaxTerm leaf fields = Term (Syntax leaf) (Record fields)
type instance Base (Term f a) = TermF f a
instance Functor f => Foldable.Foldable (Term f a) where project = runCofree
instance Functor f => Foldable.Unfoldable (Term f a) where embed = cofree
-- | Zip two terms by combining their annotations into a pair of annotations.
-- | If the structure of the two terms don't match, then Nothing will be returned.
zipTerms :: (Eq a, Eq annotation) => Term a annotation -> Term a annotation -> Maybe (Term a (Both annotation))
zipTerms :: (Eq annotation, Traversable f, GAlign f) => Term f annotation -> Term f annotation -> Maybe (Term f (Both annotation))
zipTerms t1 t2 = iter go (alignCofreeWith galign (const Nothing) both (These t1 t2))
where go (a :< s) = cofree . (a :<) <$> sequenceA s
-- | Return the node count of a term.
termSize :: (Prologue.Foldable f, Functor f) => Cofree f annotation -> Int
termSize :: (Prologue.Foldable f, Functor f) => Term f annotation -> Int
termSize = cata size where
size (_ :< syntax) = 1 + sum syntax
-- | Aligns (zips, retaining non-overlapping portions of the structure) a pair of terms.
alignCofreeWith :: Functor f
=> (forall a b. f a -> f b -> Maybe (f (These a b))) -- ^ A function comparing a pair of structures, returning `Just` the combined structure if they are comparable (e.g. if they have the same constructor), and `Nothing` otherwise. The 'Data.Align.Generic.galign' function is usually what you want here.
-> (These (Cofree f a) (Cofree f b) -> contrasted) -- ^ A function mapping a 'These' of incomparable terms into 'Pure' values in the resulting tree.
-> (These (Term f a) (Term f b) -> contrasted) -- ^ A function mapping a 'These' of incomparable terms into 'Pure' values in the resulting tree.
-> (a -> b -> combined) -- ^ A function mapping the input terms annotations into annotations in the 'Free' values in the resulting tree.
-> These (Cofree f a) (Cofree f b) -- ^ The input terms.
-> Free (CofreeF f combined) contrasted
-> These (Term f a) (Term f b) -- ^ The input terms.
-> Free (TermF f combined) contrasted
alignCofreeWith compare contrast combine = go
where go terms = fromMaybe (pure (contrast terms)) $ case terms of
These t1 t2 -> wrap . (combine (extract t1) (extract t2) :<) . fmap go <$> compare (unwrap t1) (unwrap t2)

View File

@ -11,10 +11,10 @@ import Test.QuickCheck hiding (Fixed)
data ArbitraryTerm leaf annotation = ArbitraryTerm { annotation :: annotation, syntax :: Syntax leaf (ArbitraryTerm leaf annotation)}
deriving (Show, Eq, Generic)
unArbitraryTerm :: ArbitraryTerm leaf annotation -> TermF leaf annotation (ArbitraryTerm leaf annotation)
unArbitraryTerm :: ArbitraryTerm leaf annotation -> TermF (Syntax leaf) annotation (ArbitraryTerm leaf annotation)
unArbitraryTerm (ArbitraryTerm a s) = a :< s
toTerm :: ArbitraryTerm leaf annotation -> Term leaf annotation
toTerm :: ArbitraryTerm leaf annotation -> Term (Syntax leaf) annotation
toTerm = unfold unArbitraryTerm
termOfSize :: (Arbitrary leaf, Arbitrary annotation) => Int -> Gen (ArbitraryTerm leaf annotation)
@ -26,7 +26,7 @@ arbitraryTermSize = cata (succ . sum) . toTerm
-- Instances
type instance Base (ArbitraryTerm leaf annotation) = TermF leaf annotation
type instance Base (ArbitraryTerm leaf annotation) = TermF (Syntax leaf) annotation
instance Unfoldable (ArbitraryTerm leaf annotation) where embed (a :< s) = ArbitraryTerm a s
instance (Eq leaf, Eq annotation, Arbitrary leaf, Arbitrary annotation) => Arbitrary (ArbitraryTerm leaf annotation) where

View File

@ -1,11 +1,13 @@
{-# LANGUAGE DataKinds #-}
module TreeSitter where
module TreeSitter (treeSitterParser) where
import Prologue hiding (Constructor)
import Control.Monad
import Category
import Data.Record
import Language
import qualified Language.JavaScript as JS
import qualified Language.C as C
import Parser
import Range
import Source
@ -29,97 +31,32 @@ treeSitterParser language grammar blob = do
ts_document_free document
pure term)
-- Given a language and a node name, return the correct categories.
categoriesForLanguage :: Language -> Text -> Category
categoriesForLanguage language name = case (language, name) of
(JavaScript, "object") -> Object
(JavaScript, "expression_statement") -> ExpressionStatements
(JavaScript, "this_expression") -> Identifier
(JavaScript, "null") -> Identifier
(JavaScript, "undefined") -> Identifier
(JavaScript, "arrow_function") -> Function
(JavaScript, "generator_function") -> Function
(JavaScript, "math_op") -> BinaryOperator -- bitwise operator, e.g. +, -, *, /.
(JavaScript, "bool_op") -> BinaryOperator -- boolean operator, e.g. ||, &&.
(JavaScript, "comma_op") -> CommaOperator -- comma operator, e.g. expr1, expr2.
(JavaScript, "delete_op") -> Operator -- delete operator, e.g. delete x[2].
(JavaScript, "type_op") -> Operator -- type operator, e.g. typeof Object.
(JavaScript, "void_op") -> Operator -- void operator, e.g. void 2.
(JavaScript, "for_in_statement") -> For
(JavaScript, "for_of_statement") -> For
(JavaScript, "new_expression") -> Constructor
(JavaScript, "class") -> Class
(JavaScript, "catch") -> Catch
(JavaScript, "finally") -> Finally
(JavaScript, "if_statement") -> If
(JavaScript, "empty_statement") -> Empty
(Ruby, "hash") -> Object
_ -> defaultCategoryForNodeName name
{-# INLINE categoriesForLanguage #-}
-- | Given a node name from TreeSitter, return the correct categories.
defaultCategoryForNodeName :: Text -> Category
defaultCategoryForNodeName name = case name of
"program" -> Program
"ERROR" -> Error
"function_call" -> FunctionCall
"pair" -> Pair
"string" -> StringLiteral
"integer" -> IntegerLiteral
"symbol" -> SymbolLiteral
"array" -> ArrayLiteral
"function" -> Function
"identifier" -> Identifier
"formal_parameters" -> Params
"arguments" -> Args
"statement_block" -> ExpressionStatements
"assignment" -> Assignment
"member_access" -> MemberAccess
"op" -> Operator
"subscript_access" -> SubscriptAccess
"regex" -> Regex
"template_string" -> TemplateString
"var_assignment" -> VarAssignment
"var_declaration" -> VarDecl
"switch_statement" -> Switch
"math_assignment" -> MathAssignment
"case" -> Case
"true" -> Boolean
"false" -> Boolean
"ternary" -> Ternary
"for_statement" -> For
"while_statement" -> While
"do_statement" -> DoWhile
"return_statement" -> Return
"throw_statement" -> Throw
"try_statement" -> Try
"method_definition" -> Method
"comment" -> Comment
"bitwise_op" -> BitwiseOperator
"rel_op" -> RelationalOperator
_ -> Other name
{-# INLINE defaultCategoryForNodeName #-}
-- | Return a parser for a tree sitter language & document.
documentToTerm :: Language -> Ptr Document -> Parser (Syntax.Syntax Text) (Record '[Range, Category])
documentToTerm language document blob = alloca $ \ root -> do
documentToTerm language document SourceBlob{..} = alloca $ \ root -> do
ts_document_root_node_p document root
toTerm root
where toTerm node = do
name <- ts_node_p_name node document
name <- peekCString name
count <- ts_node_p_named_child_count node
children <- traverse (alloca . getChild node) $ take (fromIntegral count) [0..]
children <- filter isNonEmpty <$> traverse (alloca . getChild node) (take (fromIntegral count) [0..])
let range = Range { start = fromIntegral $ ts_node_p_start_char node, end = fromIntegral $ ts_node_p_end_char node }
let sourceSpan = SourceSpan { spanName = toS (path blob)
let sourceSpan = SourceSpan { spanName = toS path
, spanStart = SourcePos (fromIntegral $! ts_node_p_start_point_row node) (fromIntegral $! ts_node_p_start_point_column node)
, spanEnd = SourcePos (fromIntegral $! ts_node_p_end_point_row node) (fromIntegral $! ts_node_p_end_point_column node) }
-- Note: The strict application here is semantically important. Without it, we may not evaluate the range until after weve exited the scope that `node` was allocated within, meaning `alloca` will free it & other stack data may overwrite it.
let info = range `seq` range .: categoriesForLanguage language (toS name) .: RNil
termConstructor (source blob) (sourceSpan `seq` pure sourceSpan) info (filter (\child -> category (extract child) /= Empty) children)
-- Note: The strict application here is semantically important.
-- Without it, we may not evaluate the range until after weve exited
-- the scope that `node` was allocated within, meaning `alloca` will
-- free it & other stack data may overwrite it.
range `seq` termConstructor source (pure $! sourceSpan) (toS name) range children
getChild node n out = ts_node_p_named_child node n out >> toTerm out
{-# INLINE getChild #-}
termConstructor = case language of
JavaScript -> JS.termConstructor
C -> C.termConstructor
_ -> Language.termConstructor
isNonEmpty child = category (extract child) /= Empty

View File

@ -32,7 +32,7 @@ spec :: Spec
spec = parallel $ do
describe "alignBranch" $ do
it "produces symmetrical context" $
alignBranch getRange ([] :: [Join These (SplitDiff String (Record '[Range]))]) (both [Range 0 2, Range 2 4] [Range 0 2, Range 2 4]) `shouldBe`
alignBranch getRange ([] :: [Join These (SplitDiff (Syntax String) (Record '[Range]))]) (both [Range 0 2, Range 2 4] [Range 0 2, Range 2 4]) `shouldBe`
[ Join (These (Range 0 2, [])
(Range 0 2, []))
, Join (These (Range 2 4, [])
@ -40,7 +40,7 @@ spec = parallel $ do
]
it "produces asymmetrical context" $
alignBranch getRange ([] :: [Join These (SplitDiff String (Record '[Range]))]) (both [Range 0 2, Range 2 4] [Range 0 1]) `shouldBe`
alignBranch getRange ([] :: [Join These (SplitDiff (Syntax String) (Record '[Range]))]) (both [Range 0 2, Range 2 4] [Range 0 1]) `shouldBe`
[ Join (These (Range 0 2, [])
(Range 0 1, []))
, Join (This (Range 2 4, []))
@ -231,7 +231,7 @@ toAlignBranchInputs elements = (sources, join . (`evalState` both 0 0) . travers
branchElementContents (Margin contents) = contents
keysOfAlignedChildren :: [Join These (Range, [(String, Range)])] -> [String]
keysOfAlignedChildren lines = lines >>= these identity identity (++) . runJoin . fmap (fmap Prologue.fst . Prologue.snd)
keysOfAlignedChildren lines = lines >>= these identity identity (<>) . runJoin . fmap (fmap Prologue.fst . Prologue.snd)
joinCrosswalk :: Bicrosswalk p => Align f => (a -> f b) -> Join p a -> f (Join p b)
joinCrosswalk f = fmap Join . bicrosswalk f f . runJoin
@ -257,13 +257,13 @@ instance Arbitrary BranchElement where
counts :: [Join These (Int, a)] -> Both Int
counts numbered = fromMaybe 0 . getLast . mconcat . fmap Last <$> Join (unalign (runJoin . fmap Prologue.fst <$> numbered))
align :: Both (Source.Source Char) -> ConstructibleFree (Patch (Term String (Record '[Range]))) (Both (Record '[Range])) -> PrettyDiff (SplitDiff String (Record '[Range]))
align :: Both (Source.Source Char) -> ConstructibleFree (Patch (Term (Syntax String) (Record '[Range]))) (Both (Record '[Range])) -> PrettyDiff (SplitDiff (Syntax String) (Record '[Range]))
align sources = PrettyDiff sources . fmap (fmap (getRange &&& identity)) . alignDiff sources . deconstruct
info :: Int -> Int -> Record '[Range]
info start end = Range start end .: RNil
prettyDiff :: Both (Source.Source Char) -> [Join These (ConstructibleFree (SplitPatch (Term String (Record '[Range]))) (Record '[Range]))] -> PrettyDiff (SplitDiff String (Record '[Range]))
prettyDiff :: Both (Source.Source Char) -> [Join These (ConstructibleFree (SplitPatch (Term (Syntax String) (Record '[Range]))) (Record '[Range]))] -> PrettyDiff (SplitDiff (Syntax String) (Record '[Range]))
prettyDiff sources = PrettyDiff sources . fmap (fmap ((getRange &&& identity) . deconstruct))
data PrettyDiff a = PrettyDiff { unPrettySources :: Both (Source.Source Char), unPrettyLines :: [Join These (Range, a)] }
@ -273,23 +273,23 @@ instance Show a => Show (PrettyDiff a) where
showsPrec _ (PrettyDiff sources lines) = (prettyPrinted ++) -- . (("\n" ++ show lines) ++)
where prettyPrinted = showLine (maximum (0 : (maximum . fmap length <$> shownLines))) <$> shownLines >>= ('\n':)
shownLines = catMaybes $ toBoth <$> lines
showLine n line = uncurry ((++) . (++ " | ")) (fromThese (replicate n ' ') (replicate n ' ') (runJoin (pad n <$> line)))
showLine n line = uncurry ((<>) . (++ " | ")) (fromThese (replicate n ' ') (replicate n ' ') (runJoin (pad n <$> line)))
showDiff (range, _) = filter (/= '\n') . toList . Source.slice range
pad n string = (++) (take n string) (replicate (max 0 (n - length string)) ' ')
pad n string = (<>) (take n string) (replicate (max 0 (n - length string)) ' ')
toBoth them = showDiff <$> them `applyThese` modifyJoin (uncurry These) sources
newtype ConstructibleFree patch annotation = ConstructibleFree { deconstruct :: Free (CofreeF (Syntax String) annotation) patch }
class PatchConstructible p where
insert :: Term String (Record '[Range]) -> p
delete :: Term String (Record '[Range]) -> p
insert :: Term (Syntax String) (Record '[Range]) -> p
delete :: Term (Syntax String) (Record '[Range]) -> p
instance PatchConstructible (Patch (Term String (Record '[Range]))) where
instance PatchConstructible (Patch (Term (Syntax String) (Record '[Range]))) where
insert = Insert
delete = Delete
instance PatchConstructible (SplitPatch (Term String (Record '[Range]))) where
instance PatchConstructible (SplitPatch (Term (Syntax String) (Record '[Range]))) where
insert = SplitInsert
delete = SplitDelete

View File

@ -21,14 +21,14 @@ spec = parallel $ do
let positively = succ . abs
describe "pqGramDecorator" $ do
prop "produces grams with stems of the specified length" $
\ (term, p, q) -> pqGramDecorator (rhead . headF) (positively p) (positively q) (toTerm term :: Term Text (Record '[Text])) `shouldSatisfy` all ((== (positively p)) . length . stem . rhead)
\ (term, p, q) -> pqGramDecorator (rhead . headF) (positively p) (positively q) (toTerm term :: Term (Syntax Text) (Record '[Text])) `shouldSatisfy` all ((== (positively p)) . length . stem . rhead)
prop "produces grams with bases of the specified width" $
\ (term, p, q) -> pqGramDecorator (rhead . headF) (positively p) (positively q) (toTerm term :: Term Text (Record '[Text])) `shouldSatisfy` all ((== (positively q)) . length . base . rhead)
\ (term, p, q) -> pqGramDecorator (rhead . headF) (positively p) (positively q) (toTerm term :: Term (Syntax Text) (Record '[Text])) `shouldSatisfy` all ((== (positively q)) . length . base . rhead)
describe "featureVectorDecorator" $ do
prop "produces a vector of the specified dimension" $
\ (term, p, q, d) -> featureVectorDecorator (rhead . headF) (positively p) (positively q) (positively d) (toTerm term :: Term Text (Record '[Text])) `shouldSatisfy` all ((== (positively d)) . length . rhead)
\ (term, p, q, d) -> featureVectorDecorator (rhead . headF) (positively p) (positively q) (positively d) (toTerm term :: Term (Syntax Text) (Record '[Text])) `shouldSatisfy` all ((== (positively d)) . length . rhead)
describe "rws" $ do
let decorate = defaultFeatureVectorDecorator (category . headF)

View File

@ -26,7 +26,7 @@ arrayInfo = ArrayLiteral .: Range 0 3 .: RNil
literalInfo :: Record '[Category, Range]
literalInfo = StringLiteral .: Range 1 2 .: RNil
testDiff :: Diff Text (Record '[Category, Range])
testDiff :: Diff (Syntax Text) (Record '[Category, Range])
testDiff = free $ Free (pure arrayInfo :< Indexed [ free $ Pure (Insert (cofree $ literalInfo :< Leaf "a")) ])
testSummary :: DiffSummary DiffInfo
@ -67,7 +67,7 @@ spec = parallel $ do
extractLeaves (BranchInfo children _ _) = join $ extractLeaves <$> children
extractLeaves leaf = [ leaf ]
extractDiffLeaves :: Term Text (Record '[Category, Range]) -> [ Term Text (Record '[Category, Range]) ]
extractDiffLeaves :: Term (Syntax Text) (Record '[Category, Range]) -> [ Term (Syntax Text) (Record '[Category, Range]) ]
extractDiffLeaves term = case unwrap term of
(Indexed children) -> join $ extractDiffLeaves <$> children
(Fixed children) -> join $ extractDiffLeaves <$> children
@ -81,7 +81,7 @@ spec = parallel $ do
in
length listOfLeaves `shouldBe` length listOfDiffLeaves
isIndexedOrFixed :: Patch (Term a annotation) -> Bool
isIndexedOrFixed :: Patch (Term (Syntax a) annotation) -> Bool
isIndexedOrFixed = any (isIndexedOrFixed' . unwrap)
isIndexedOrFixed' :: Syntax a f -> Bool

100
weekly/2016-09-09.md Normal file
View File

@ -0,0 +1,100 @@
# September 9th, 2016
- Hack week was last week and we skipped the weekly.
- We moved the weekly to the end of the week to try to cut down on the “wait, what _did_ happen last week?” thing.
- This ended up being @tclems first weekly 👋
#### What went well?
@joshvera:
Hack week:
- Made a lot of progress on the TypeScript parser.
- May be able to use that as the basis for a more rigorous JavaScript parser as well.
This week:
- Understand RWS & some other diffing algos a lot better than before.
@rewinfrey:
- Pairing w/ @tclem.
- Updating test cases is much more efficient.
- Modelling effects in Free.
@tclem:
- Little fixes.
- Static linking of ICU in dev.
- statsd client.
@robrix:
- semantic-diffd
- Docker
- kubes
- Markdown
#### What were the challenges?
@joshvera:
- Integrating a pass before RWS. Using constant-time (per-subtree)SES before RWS to match up equal things. There are some ordering problems with the result.
- Ambiguities in the TypeScript grammar. Possibly due to JS actually being context-sensitive. @maxbrunsfeld advises parsing a superset of the language… but which superset?
@rewinfrey:
- Trying to get an effect system in Free. Got it, but tricky.
- Also picked up an issue with template strings which defies debugging.
@tclem:
- > My head hurts by the end of the day.
- Being challenged by some of the new concepts, the vernacular &c.
- Hard to know when to jump down the rabbit hole and learn a thing or when to gloss over it.
- Have a queue of things to read.
@robrix:
- Converting between line/column ranges and character ranges.
#### What did you learn?
@joshvera:
- > I became one with the TypeScript grammar.
- > Maybe we should find a way to have the grammars write themselves.
- Working on this `effects` package (formerly called `freer`) & its `Eff` type. It uses an open union data structure, which `Data.Record` is sort of an approximation of. `Eff` has this detail where its list of function types are “type-aligned.” Every item in the list is a function type where they all chain together, a -> b, b -> c, etc. Adding, removing, & replacing effects is constant-time.
@rewinfrey:
- Free, and how to model effects in Free.
- Straight-up category theory stuff. Compositions of natural transformations &c.
@tclem:
- Post about functors, applicatives, and monads shown in pictures.
- How this manages to be a bridge between pure & stateful functions.
- Helped explain the optparse-applicative syntax.
@robrix:
- CMark exists, which is cool.
- Parsing/term ingestion had been producing errors for weirdly-formatted for loops &c. Not only were we hitting this on a regular basis, it was also causing confusing/poor change summaries.
#### Meta
“What were the challenges?” can be a bit redundant with “what did you learn?” Should we focus this on challenges that we need help with? Gonna give that a try.
Next week: @joshvera, @rewinfrey, & @robrix are off to ICFP. @tclem may or may not hold weekly solo at his discretion.