From 696d538d05db1afe693755a071ecd8e941487978 Mon Sep 17 00:00:00 2001 From: Anupam Jain Date: Tue, 4 Jul 2023 17:54:05 +0530 Subject: [PATCH] Format purescript. Convert CommonJS to ESmodule. --- src/Data/Data.purs | 152 ++++++++++++++++++++--------------------- src/Data/Dynamic.purs | 1 + src/Data/Typeable.js | 105 ++++++++++++++-------------- src/Data/Typeable.purs | 73 ++++++++++---------- 4 files changed, 166 insertions(+), 165 deletions(-) diff --git a/src/Data/Data.purs b/src/Data/Data.purs index 4854626..b83a600 100644 --- a/src/Data/Data.purs +++ b/src/Data/Data.purs @@ -36,38 +36,42 @@ mkM f = fromMaybe pure (cast f) -- So we manually reify the dictionary into the DataDict datatype -- Not using wrapped records here because Purescript can't handle constraints inside records newtype DataDict a = DataDict - (forall c. (forall d b. Data d => c (d -> b) -> d -> c b) - -- ^ defines how nonempty constructor applications are - -- folded. It takes the folded tail of the constructor - -- application and its head, i.e., an immediate subterm, - -- and combines them in some way. - -> (forall g. g -> c g) - -- ^ defines how the empty constructor application is - -- folded, like the neutral \/ start element for list - -- folding. - -> a - -- ^ structure to be folded. - -> c a - -- ^ result, with a type defined in terms of @a@, but - -- variability is achieved by means of type constructor - -- @c@ for the construction of the actual result type. + ( forall c + . (forall d b. Data d => c (d -> b) -> d -> c b) + -- ^ defines how nonempty constructor applications are + -- folded. It takes the folded tail of the constructor + -- application and its head, i.e., an immediate subterm, + -- and combines them in some way. + -> (forall g. g -> c g) + -- ^ defines how the empty constructor application is + -- folded, like the neutral \/ start element for list + -- folding. + -> a + -- ^ structure to be folded. + -> c a + -- ^ result, with a type defined in terms of @a@, but + -- variability is achieved by means of type constructor + -- @c@ for the construction of the actual result type. ) -gfoldl :: forall a c. Data a => (forall d b. Data d => c (d -> b) -> d -> c b) - -- ^ defines how nonempty constructor applications are - -- folded. It takes the folded tail of the constructor - -- application and its head, i.e., an immediate subterm, - -- and combines them in some way. - -> (forall g. g -> c g) - -- ^ defines how the empty constructor application is - -- folded, like the neutral \/ start element for list - -- folding. - -> a - -- ^ structure to be folded. - -> c a - -- ^ result, with a type defined in terms of @a@, but - -- variability is achieved by means of type constructor - -- @c@ for the construction of the actual result type. +gfoldl + :: forall a c + . Data a + => (forall d b. Data d => c (d -> b) -> d -> c b) + -- ^ defines how nonempty constructor applications are + -- folded. It takes the folded tail of the constructor + -- application and its head, i.e., an immediate subterm, + -- and combines them in some way. + -> (forall g. g -> c g) + -- ^ defines how the empty constructor application is + -- folded, like the neutral \/ start element for list + -- folding. + -> a + -- ^ structure to be folded. + -> c a +-- ^ result, with a type defined in terms of @a@, but +-- variability is achieved by means of type constructor +-- @c@ for the construction of the actual result type. gfoldl = let DataDict f = dataDict in f class Typeable a <= Data a where @@ -86,26 +90,25 @@ gmapT :: forall a. Data a => (forall b. Data b => b -> b) -> a -> a -- gmapT f x0 = unwrap (gfoldl k Identity x0) where - k :: forall d b. Data d => Identity (d->b) -> d -> Identity b - k (Identity c) x = Identity (c (f x)) - + k :: forall d b. Data d => Identity (d -> b) -> d -> Identity b + k (Identity c) x = Identity (c (f x)) -- | A generic query with a left-associative binary operator gmapQl :: forall a r r'. Data a => (r -> r' -> r) -> r -> (forall d. Data d => d -> r') -> a -> r gmapQl o r f = unwrap <<< gfoldl k z where - k :: forall d b. Data d => Const r (d->b) -> d -> Const r b - k c x = Const $ (unwrap c) `o` f x - z :: forall g. g -> Const r g - z _ = Const r + k :: forall d b. Data d => Const r (d -> b) -> d -> Const r b + k c x = Const $ (unwrap c) `o` f x + + z :: forall g. g -> Const r g + z _ = Const r -- | A generic query with a right-associative binary operator gmapQr :: forall a r r'. Data a => (r' -> r -> r) -> r -> (forall d. Data d => d -> r') -> a -> r gmapQr o r0 f x0 = unQr (gfoldl k (const (Qr identity)) x0) r0 where - k :: forall d b. Data d => Qr r (d->b) -> d -> Qr r b - k (Qr c) x = Qr (\r -> c (f x `o` r)) - + k :: forall d b. Data d => Qr r (d -> b) -> d -> Qr r b + k (Qr c) x = Qr (\r -> c (f x `o` r)) -- | A generic query that processes the immediate subterms and returns a list -- of results. The list is given in the same order as originally specified @@ -113,18 +116,18 @@ gmapQr o r0 f x0 = unQr (gfoldl k (const (Qr identity)) x0) r0 gmapQ :: forall a u. Data a => (forall d. Data d => d -> u) -> a -> Array u gmapQ f = gmapQr (A.cons) [] f - -- | A generic query that processes one child by index (zero-based) gmapQi :: forall u a. Data a => Int -> (forall d. Data d => d -> u) -> a -> u -gmapQi i f x = case gfoldl k z x of Qi _ q -> case q of - Nothing -> unsafeCoerce "UNEXPECTED NOTHING" - Just q' -> q' +gmapQi i f x = case gfoldl k z x of + Qi _ q -> case q of + Nothing -> unsafeCoerce "UNEXPECTED NOTHING" + Just q' -> q' where - k :: forall d b. Data d => Qi u (d -> b) -> d -> Qi u b - k (Qi i' q) a = Qi (i'+1) (if i==i' then Just (f a) else q) - z :: forall g q. g -> Qi q g - z _ = Qi 0 Nothing + k :: forall d b. Data d => Qi u (d -> b) -> d -> Qi u b + k (Qi i' q) a = Qi (i' + 1) (if i == i' then Just (f a) else q) + z :: forall g q. g -> Qi q g + z _ = Qi 0 Nothing -- | A generic monadic transformation that maps over the immediate subterms -- @@ -139,11 +142,11 @@ gmapM :: forall m a. Data a => Monad m => (forall d. Data d => d -> m d) -> a -> -- gmapM f = gfoldl k pure where - k :: forall b d. Data d => m (d -> b) -> d -> m b - k c x = do c' <- c - x' <- f x - pure (c' x') - + k :: forall b d. Data d => m (d -> b) -> d -> m b + k c x = do + c' <- c + x' <- f x + pure (c' x') -- | Transformation of at least one immediate subterm does not fail gmapMp :: forall m a. Data a => MonadPlus m => (forall d. Data d => d -> m d) -> a -> m a @@ -157,16 +160,17 @@ this end, we couple the monadic computation with a Boolean. -} gmapMp f x = unMp (gfoldl k z x) >>= \(Tuple x' b) -> - if b then pure x' else empty + if b then pure x' else empty where - z :: forall g. g -> Mp m g - z g = Mp (pure (Tuple g false)) - k :: forall d b. Data d => Mp m (d -> b) -> d -> Mp m b - k (Mp c) y - = Mp ( c >>= \(Tuple h b) -> - (f y >>= \y' -> pure (Tuple (h y') true)) - <|> pure (Tuple (h y) b) - ) + z :: forall g. g -> Mp m g + z g = Mp (pure (Tuple g false)) + + k :: forall d b. Data d => Mp m (d -> b) -> d -> Mp m b + k (Mp c) y = Mp + ( c >>= \(Tuple h b) -> + (f y >>= \y' -> pure (Tuple (h y') true)) + <|> pure (Tuple (h y) b) + ) -- | Transformation of one immediate subterm with success gmapMo :: forall m a. Data a => MonadPlus m => (forall d. Data d => d -> m d) -> a -> m a @@ -182,25 +186,23 @@ was transformed successfully. -} gmapMo f x = unMp (gfoldl k z x) >>= \(Tuple x' b) -> - if b then pure x' else empty + if b then pure x' else empty where - z :: forall g. g -> Mp m g - z g = Mp (pure (Tuple g false)) - k :: forall d b. Data d => Mp m (d -> b) -> d -> Mp m b - k (Mp c) y - = Mp ( c >>= \(Tuple h b) -> if b - then pure (Tuple (h y) b) - else (f y >>= \y' -> pure (Tuple (h y') true)) - <|> pure (Tuple (h y) b) - ) - + z :: forall g. g -> Mp m g + z g = Mp (pure (Tuple g false)) + k :: forall d b. Data d => Mp m (d -> b) -> d -> Mp m b + k (Mp c) y = Mp + ( c >>= \(Tuple h b) -> + if b then pure (Tuple (h y) b) + else (f y >>= \y' -> pure (Tuple (h y') true)) + <|> pure (Tuple (h y) b) + ) -- | Type constructor for adding counters to queries data Qi :: forall k. Type -> k -> Type data Qi q a = Qi Int (Maybe q) - -- | The type constructor used in definition of gmapQr newtype Qr :: forall k. Type -> k -> Type newtype Qr r a = Qr (r -> r) @@ -214,7 +216,6 @@ newtype Mp m x = Mp (m (Tuple x Boolean)) unMp :: forall m x. Mp m x -> m (Tuple x Boolean) unMp (Mp f) = f - -- | Left-associative fold operation for constructor applications. -- -- The type of 'gfoldl' is a headache, but operationally it is a simple @@ -224,7 +225,6 @@ unMp (Mp f) = f -- suitable for abstract datatypes with no substructures. -- gfoldl - -- TODO: Why do we need `TagT` here? Instead of `Typeable`. instance dataArray :: (TagT a, Data a) => Data (Array a) where dataDict = DataDict \k z arr -> case A.uncons arr of diff --git a/src/Data/Dynamic.purs b/src/Data/Dynamic.purs index 149042b..d1d8565 100644 --- a/src/Data/Dynamic.purs +++ b/src/Data/Dynamic.purs @@ -11,6 +11,7 @@ import Data.Typeable (class Typeable, TypeRep, eqT, typeRep) -- | and forgets the type of `a` data Dynamic' :: forall k. (k -> Type) -> k -> Type data Dynamic' t a = Dynamic' (TypeRep a) (t a) + data Dynamic t = Dynamic (Exists (Dynamic' t)) -- | Wrap a value into a dynamic diff --git a/src/Data/Typeable.js b/src/Data/Typeable.js index 8abcb06..826f1fd 100644 --- a/src/Data/Typeable.js +++ b/src/Data/Typeable.js @@ -1,76 +1,75 @@ // var _tag_id_counter = 1; -exports.typeRepDefault0 = function(t) { - // if(t.__uniqueId == undefined) t.__uniqueId = _tag_id_counter++; - return t; -}; +export function typeRepDefault0(t) { + // if(t.__uniqueId == undefined) t.__uniqueId = _tag_id_counter++; + return t; +} -exports.typeRepFromTag1 = pack('tagT'); +export const typeRepFromTag1 = pack('tagT'); -exports.showTypeRep = function(t) { - return "" + t; -}; +export function showTypeRep(t) { + return "" + t; +} -exports.proxyT = tag; +export const proxyT = tag; // Just a JS class, instances of which can be tested for equality -function tag() {} +function tag() { } -exports.proxyTFromTagT = pack('tagT'); +export const proxyTFromTagT = pack('tagT'); function pack(tagName) { - return function(origTag) { - let unwrappedTag = origTag[tagName]; - return function(dict) { - if(unwrappedTag.tag) return {tag:unwrappedTag.tag, args:unwrappedTag.args.concat(dict)}; - return {tag: origTag, args: [dict]}; - }; + return function(origTag) { + let unwrappedTag = origTag[tagName]; + return function(dict) { + if (unwrappedTag.tag) return { tag: unwrappedTag.tag, args: unwrappedTag.args.concat(dict) }; + return { tag: origTag, args: [dict] }; }; + }; }; -exports.eqTypeRep = function(t1) { - return function(t2) { - return eqTypeRepHelper(t1,t2); - }; -}; +export function eqTypeRep(t1) { + return function(t2) { + return eqTypeRepHelper(t1, t2); + }; +} // foreign import typeRowToTypeRep :: forall r rl. RL.RowToList r rl => TypeRow rl -> TypeRep (Record r) -exports.typeRowToTypeRep = function() { - return function(trow) { - return trow; - }; -}; +export function typeRowToTypeRep() { + return function(trow) { + return trow; + }; +} // foreign import typeRowCons :: forall s t rs. SProxy s -> String -> TypeRep t -> TypeRow rs -> TypeRow (RL.Cons s t rs) -exports.typeRowCons = function(_) { - return function(s) { - return function(t) { - return function(r) { - return {record: r.record.concat({field:s,typ:t})}; - }; - }; +export function typeRowCons(_) { + return function(s) { + return function(t) { + return function(r) { + return { record: r.record.concat({ field: s, typ: t }) }; + }; }; -}; + }; +} -// foreign import typeRowNil :: TypeRow RL.Nil -exports.typeRowNil = {record: []}; +export const typeRowNil = { record: [] }; -function eqTypeRepHelper(t1,t2) { - if(t1.tagT) return t1 === t2; - if(t1.tag !== t2.tag) return false; - if(t1.record) { - if(!t2.record) return false; - if(t1.record.length !== t2.record.length) return false; - for(var i=0; i String data ProxyT :: forall k. k -> Type data ProxyT t -foreign import proxyT :: forall t. ProxyT t +foreign import proxyT :: forall t. ProxyT t class TagT :: forall k. k -> Constraint -class TagT a where tagT :: ProxyT a +class TagT a where + tagT :: ProxyT a foreign import proxyTFromTagT :: forall t a. TagT t => Typeable a => ProxyT (t a) instance typeableRecord :: (RL.RowToList rs ls, TypeableRecordFields ls) => Typeable (Record rs) where typeRep = typeRowToTypeRep (typeableRecordFields (RLProxy :: _ ls)) -else -instance typeableTag1 :: (TagT t, Typeable a) => Typeable (t a) where +else instance typeableTag1 :: (TagT t, Typeable a) => Typeable (t a) where typeRep = typeRepFromTag1 -else -instance typeableTag0 :: TagT t => Typeable t where +else instance typeableTag0 :: TagT t => Typeable t where typeRep = typeRepDefault0 instance tagTFromTagT :: (TagT t, Typeable a) => TagT (t a) where @@ -132,6 +133,7 @@ instance tagTFromTagT :: (TagT t, Typeable a) => TagT (t a) where -- (r :: RL.RLProxy) data TypeRow :: forall k. k -> Type data TypeRow r + foreign import typeRowToTypeRep :: forall r rl. RL.RowToList r rl => TypeRow rl -> TypeRep (Record r) foreign import typeRowNil :: TypeRow RL.Nil foreign import typeRowCons :: forall s t rs. SProxy s -> String -> TypeRep t -> TypeRow rs -> TypeRow (RL.Cons s t rs) @@ -144,17 +146,16 @@ class TypeableRecordFields rowlist where instance typeableRecordFieldsNil :: TypeableRecordFields RL.Nil where typeableRecordFields _ = typeRowNil -instance typeableRecordFieldsCons - :: ( IsSymbol key - , TypeableRecordFields rowlistTail - , Typeable focus - ) - => TypeableRecordFields (RL.Cons key focus rowlistTail) where - typeableRecordFields _ - = typeRowCons key (reflectSymbol key) (typeRep :: _ focus) tail +instance typeableRecordFieldsCons :: + ( IsSymbol key + , TypeableRecordFields rowlistTail + , Typeable focus + ) => + TypeableRecordFields (RL.Cons key focus rowlistTail) where + typeableRecordFields _ = typeRowCons key (reflectSymbol key) (typeRep :: _ focus) tail where - key = SProxy :: _ key - tail = typeableRecordFields (RLProxy :: _ rowlistTail) + key = SProxy :: _ key + tail = typeableRecordFields (RLProxy :: _ rowlistTail) instance taggedInt :: TagT Int where tagT = proxyT