1
1
mirror of https://github.com/github/semantic.git synced 2024-12-23 14:54:16 +03:00

Migrate semantic-diff to lts-8.0.

This commit is contained in:
Rob Rix 2017-02-13 17:25:45 -05:00
parent 8e2c3e0147
commit 7d284252c5
9 changed files with 31 additions and 25 deletions

View File

@ -28,15 +28,15 @@ data GenerateFormat =
| GenerateJSON
deriving (Show)
data GeneratorArgs = GeneratorArgs { generateFormat :: GenerateFormat } deriving (Show)
newtype GeneratorArgs = GeneratorArgs { generateFormat :: GenerateFormat } deriving (Show)
generatorArgs :: Parser GeneratorArgs
generatorArgs = GeneratorArgs
<$> (flag' GenerateSummaries (long "generate-summaries" O.<> short 's' O.<> help "Generates summary results for new JSON test cases")
<|> flag' GenerateJSON (long "generate-json" O.<> short 'j' O.<> help "Generate JSON output for new JSON test cases"))
<$> (flag' GenerateSummaries (long "generate-summaries" <> short 's' <> help "Generates summary results for new JSON test cases")
<|> flag' GenerateJSON (long "generate-json" <> short 'j' <> help "Generate JSON output for new JSON test cases"))
options :: ParserInfo GeneratorArgs
options = info (helper <*> generatorArgs) (fullDesc O.<> progDesc "Auto-generate JSON test cases" O.<> header "JSON Test Case Generator")
options = info (helper <*> generatorArgs) (fullDesc <> progDesc "Auto-generate JSON test cases" <> header "JSON Test Case Generator")
main :: IO ()
main = do

View File

@ -117,7 +117,7 @@ instance Listable1 f => Listable2 (CofreeF f) where
instance (Listable1 f, Listable a) => Listable1 (CofreeF f a) where
liftTiers = liftTiers2 tiers
instance Listable1 f => Listable1 (Cofree f) where
instance (Functor f, Listable1 f) => Listable1 (Cofree f) where
liftTiers annotationTiers = go
where go = liftCons1 (liftTiers2 annotationTiers go) cofree
@ -127,7 +127,7 @@ instance Listable1 f => Listable2 (FreeF f) where
instance (Listable1 f, Listable a) => Listable1 (FreeF f a) where
liftTiers = liftTiers2 tiers
instance Listable1 f => Listable1 (Free f) where
instance (Functor f, Listable1 f) => Listable1 (Free f) where
liftTiers pureTiers = go
where go = liftCons1 (liftTiers2 pureTiers go) free

View File

@ -269,7 +269,8 @@ pqGramDecorator getLabel p q = cata algebra
gram label = Gram (padToSize p []) (padToSize q (pure (Just label)))
assignParentAndSiblingLabels functor label = (`evalState` (replicate (q `div` 2) Nothing <> siblingLabels functor)) (for functor (assignLabels label))
assignLabels :: label
assignLabels :: Functor f
=> label
-> Term f (Record (Gram label ': fields))
-> State [Maybe label] (Term f (Record (Gram label ': fields)))
assignLabels label a = case runCofree a of

View File

@ -3,7 +3,6 @@
module Diff where
import Prologue
import Data.Functor.Foldable as F
import Data.Functor.Both as Both
import Data.Mergeable
import Data.Record
@ -17,10 +16,6 @@ type Diff f annotation = Free (TermF f (Both annotation)) (Patch (Term f annotat
type SyntaxDiff leaf fields = Diff (Syntax leaf) (Record fields)
type instance Base (Free f a) = FreeF f a
instance Functor f => Recursive (Free f a) where project = runFree
instance Functor f => Corecursive (Free f a) where embed = free
diffSum :: (Foldable f, Functor f) => (Patch (Term f annotation) -> Int) -> Diff f annotation -> Int
diffSum patchCost diff = sum $ fmap patchCost diff

View File

@ -46,8 +46,8 @@ The example below adds a new field to the `Record` fields.
indexedTermCata :: [leaf] -> Term (Syntax leaf) (Record '[NewField, Range, Category])
indexedTermCata childrenLeaves = cata algebra (indexedTerm childrenLeaves)
where
algebra :: CofreeF f (Record t) (Cofree f (Record (NewField : t))) -> Cofree f (Record (NewField : t))
algebra term = cofree $ (NewField :. (headF term)) :< tailF term
algebra :: Functor f => CofreeF f (Record t) (Cofree f (Record (NewField : t))) -> Cofree f (Record (NewField : t))
algebra term = cofree $ (NewField :. headF term) :< tailF term
{-
Anamorphism -- construct a Term from a string

View File

@ -61,7 +61,7 @@ leafTerm :: leaf -> Cofree (Syntax leaf) (Record '[Range, Category])
leafTerm = cofree . leafTermF
indexedTermF :: [leaf] -> TermF (Syntax leaf) (Record '[Range, Category]) (Term (Syntax leaf) (Record '[Range, Category]))
indexedTermF leaves = (Range 1 10 :. Category.MethodCall :. Nil) :< (Indexed (leafTerm <$> leaves))
indexedTermF leaves = (Range 1 10 :. Category.MethodCall :. Nil) :< Indexed (leafTerm <$> leaves)
indexedTerm :: [leaf] -> Term (Syntax leaf) (Record '[Range, Category])
indexedTerm leaves = cofree $ indexedTermF leaves

View File

@ -4,18 +4,34 @@ module Prologue
, (&&&)
, (***)
, hylo, cata, para, ana
, cofree, runCofree, free, runFree
, module Data.Hashable
) where
import Protolude as X
import Data.List (lookup)
import Control.Comonad.Trans.Cofree as X
import Control.Monad.Trans.Free as X
import Control.Comonad.Cofree as X hiding ((:<), unfold, unfoldM)
import Control.Monad.Free as X (Free())
import Control.Monad.Free as X hiding (Free(Free, Pure), unfold, unfoldM)
import Control.Comonad.Trans.Cofree as X (CofreeF(..), headF, tailF)
import Control.Monad.Trans.Free as X (FreeF(..))
import Control.Comonad as X
import Control.Arrow ((&&&), (***))
import Data.Functor.Foldable (hylo, cata, para, ana)
import Data.Functor.Foldable (hylo, cata, para, ana, project, embed)
import Data.Hashable
cofree :: Functor f => CofreeF f a (Cofree f a) -> Cofree f a
cofree = embed
runCofree :: Functor f => Cofree f a -> CofreeF f a (Cofree f a)
runCofree = project
free :: Functor f => FreeF f a (Free f a) -> Free f a
free = embed
runFree :: Functor f => Free f a -> FreeF f a (Free f a)
runFree = project

View File

@ -3,7 +3,7 @@
module SemanticDiff (main, fetchDiff, fetchDiffs) where
import Arguments
import Prologue hiding ((<>), fst, snd)
import Prologue hiding (fst, snd)
import Data.String
import Data.Functor.Both
import Data.Version (showVersion)

View File

@ -4,7 +4,6 @@ module Term where
import Prologue
import Data.Align.Generic
import Data.Functor.Foldable as Foldable
import Data.Functor.Both
import Data.Record
import Data.These
@ -18,11 +17,6 @@ type TermF = CofreeF
type SyntaxTerm leaf fields = Term (Syntax leaf) (Record fields)
type SyntaxTermF leaf fields = TermF (Syntax leaf) (Record fields)
-- Term has a Base functor TermF which gives it Recursive and Corecursive instances.
type instance Base (Term f a) = TermF f a
instance Functor f => Recursive (Term f a) where project = runCofree
instance Functor f => Corecursive (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 :: (Traversable f, GAlign f) => Term f annotation -> Term f annotation -> Maybe (Term f (Both annotation))