github/semantic
1
1
Fork 0
mirror of https://github.com/github/semantic.git synced 2024-12-22 22:31:36 +03:00
Code Issues Projects Releases Wiki Activity

Revert "Constrain record fields to be Typeable."

Browse Source 
This reverts commit 95fc1cb0ad4c7546450007b09fd690b4c84de1ce.
This commit is contained in:
Rob Rix 2016-08-05 09:59:15 -04:00
parent a34f9ae3a4
commit 995c839f3f
2 changed files with 5 additions and 5 deletions
Show Stats Download Patch File Download Diff File Expand all files Collapse all files

6
src/Data/Record.hs
View File

@ -14,13 +14,13 @@ import Test.QuickCheck
-- | This is heavily inspired by Aaron Levin’s [Extensible Effects in the van Laarhoven Free Monad](http://aaronlevin.ca/post/136494428283/extensible-effects-in-the-van-laarhoven-free-monad). -- | This is heavily inspired by Aaron Levin’s [Extensible Effects in the van Laarhoven Free Monad](http://aaronlevin.ca/post/136494428283/extensible-effects-in-the-van-laarhoven-free-monad).
data Record :: [*] -> * where data Record :: [*] -> * where
RNil :: Record '[] RNil :: Record '[]
RCons :: Typeable h => h -> Record t -> Record (h ': t) RCons :: h -> Record t -> Record (h ': t)
deriving Typeable deriving Typeable
infixr 0 .: infixr 0 .:
-- | Infix synonym for `RCons`: `a .: b .: RNil == RCons a (RCons b RNil)`. -- | Infix synonym for `RCons`: `a .: b .: RNil == RCons a (RCons b RNil)`.
(.:) :: Typeable h => h -> Record t -> Record (h ': t) (.:) :: h -> Record t -> Record (h ': t)
(.:) = RCons (.:) = RCons
@ -67,7 +67,7 @@ instance Ord (Record '[]) where
_ `compare` _ = EQ _ `compare` _ = EQ
instance (Typeable field, Arbitrary field, Arbitrary (Record fields)) => Arbitrary (Record (field ': fields)) where instance (Arbitrary field, Arbitrary (Record fields)) => Arbitrary (Record (field ': fields)) where
arbitrary = RCons <$> arbitrary <*> arbitrary arbitrary = RCons <$> arbitrary <*> arbitrary
shrink (RCons h t) = RCons <$> shrink h <*> shrink t shrink (RCons h t) = RCons <$> shrink h <*> shrink t

4
src/Diffing.hs
View File

@ -118,11 +118,11 @@ readAndTranscodeFile path = do
type TermDecorator f fields field = CofreeF f (Record fields) (Record (field ': fields)) -> field type TermDecorator f fields field = CofreeF f (Record fields) (Record (field ': fields)) -> field
-- | Decorate the 'Term's produced by a 'Parser' using a function to compute the annotation values at every node. -- | Decorate the 'Term's produced by a 'Parser' using a function to compute the annotation values at every node.
decorateParser :: (Typeable field, Functor f) => TermDecorator f fields field -> Parser f (Record fields) -> Parser f (Record (field ': fields)) decorateParser :: Functor f => TermDecorator f fields field -> Parser f (Record fields) -> Parser f (Record (field ': fields))
decorateParser decorator = (fmap (decorateTerm decorator) .) decorateParser decorator = (fmap (decorateTerm decorator) .)
-- | Decorate a 'Term' using a function to compute the annotation values at every node. -- | Decorate a 'Term' using a function to compute the annotation values at every node.
decorateTerm :: (Typeable field, Functor f) => TermDecorator f fields field -> Cofree f (Record fields) -> Cofree f (Record (field ': fields)) decorateTerm :: Functor f => TermDecorator f fields field -> Cofree f (Record fields) -> Cofree f (Record (field ': fields))
decorateTerm decorator = cata $ \ c -> cofree ((decorator (extract <$> c) .: headF c) :< tailF c) decorateTerm decorator = cata $ \ c -> cofree ((decorator (extract <$> c) .: headF c) :< tailF c)
compareCategoryEq :: HasField fields Category => Term leaf (Record fields) -> Term leaf (Record fields) -> Bool compareCategoryEq :: HasField fields Category => Term leaf (Record fields) -> Term leaf (Record fields) -> Bool