dualizer 0.1.0.0 → 0.1.0.1

raw patch · 4 files changed

+13/−50 lines, 4 files

Files

• README.md +0/−1
• dualizer.cabal +1/−1
• src/Categorical/Dual.hs +12/−40
• src/Categorical/Dual/Example.hs +0/−8

@@ -3,7 +3,6 @@ **Delete half (minus ε) of your Haskell code!**  [![Join the chat at https://gitter.im/dualizer/Lobby](https://badges.gitter.im/dualizer/Lobby.svg)](https://gitter.im/dualizer/Lobby?utm_source=badge&utm_medium=badge&utm_campaign=pr-badge&utm_content=badge)-[![Hackage](http://img.shields.io/hackage/v/dualizer.svg)](http://hackage.haskell.org/package/dualizer)  Dualizer allows you to eliminate the dual of all your code. Rather than implementing, say, `Comonad` directly, you can define it in terms of its dual – `Monad`: 

@@ -1,5 +1,5 @@ name:               dualizer-version:            0.1.0.0+version:            0.1.0.1 synopsis:           Automatically generate dual constructions. description:        A library for defining duals automatically, as well as                     labeling duals in existing packages.

@@ -16,7 +16,6 @@    , makeDualClass   , makeDualDec-  -- , withDual    , labelDual   , labelSelfDual@@ -35,6 +34,7 @@ import           Data.Map (Map) import           Data.Maybe import           Data.Monoid+import           Data.Semigroup import           Data.Tuple import           Data.Void import           Language.Haskell.TH@@ -48,13 +48,16 @@  makeLenses ''DualMappings -instance Monoid DualMappings where-  mempty = DualMappings Map.empty Map.empty-  mappend (DualMappings t v) (DualMappings t' v') =+instance Semigroup DualMappings where+  DualMappings t v <> DualMappings t' v' =     -- NB: I reversed the order here, because I _think_ this is supposed to be     --     right-biased?-    DualMappings (t' `Map.union` t) (v' `Map.union` v)+    DualMappings (Map.union t' t) (Map.union v' v) +instance Monoid DualMappings where+  mempty = DualMappings mempty mempty+  mappend = (Data.Semigroup.<>)+ -- | The empty set of duals, should only be used to initalize the duals for --   `Prelude`. emptyDuals :: Q DualMappings@@ -62,11 +65,12 @@  reifyDuals :: DualMappings -> Q Exp reifyDuals duals =-  [e|maybe $(liftData duals) ($(liftData duals) <>) <$> getQ|]+  [e|maybe $(liftData duals) (mappend $(liftData duals)) <$> getQ|]  shareDuals :: DualMappings -> Q Exp shareDuals duals =-  [e|pure [] <* (putQ . maybe $(liftData duals) ($(liftData duals) <>) =<< getQ)|]+  [e|pure []+     <* (putQ . maybe $(liftData duals) (mappend $(liftData duals)) =<< getQ)|]  -- TODO: Move this somewhere better data AndMaybe a b = Only a | Indeed a b deriving (Eq, Show)@@ -360,7 +364,7 @@ importDuals duals = do   oldDuals <- getQ   newDuals <- duals-  putQ $ maybe newDuals (newDuals <>) oldDuals+  putQ $ maybe newDuals (mappend newDuals) oldDuals   pure []  errorNewName :: Name -> Q a@@ -444,35 +448,3 @@   let coname = mkName co   db <- retrieveDuals   fmap join . traverse (dualizeDec db coname) =<< decs---- | Handles dualizing declarations that don’t introduce a new name. This---   applies the equivalent declaration to the (already created) dual.--- withDual :: Q Dec -> Q [Dec]--- withDual dec =---   dec >>= (\d ->---             (\c -> [d, c])---             <$> case d of---               FunD n _ -> errorNewName n---               ValD (VarP n) _ _ -> errorNewName n---               ValD _ _ _ -> fail "declaration introduces new names"---               DataD _ n _ _ _ _ -> errorNewName n---               NewtypeD _ n _ _ _ _ -> errorNewName n---               TySynD n _ _ -> errorNewName n---               ClassD _ n _ _ _ -> errorNewName n---               InstanceD o c t ds -> undefined---               SigD n _ -> errorNewName n---               ForeignD f -> undefined---               InfixD f n -> InfixD f <$> dualName n---               PragmaD p -> undefined---               DataFamilyD n _ _ -> errorNewName n---               DataInstD c n ts k cs dcs -> undefined---               NewtypeInstD c n ts k c' dcs -> undefined---               TySynInstD n tse -> undefined---               OpenTypeFamilyD (TypeFamilyHead n _ _ _) -> errorNewName n---               ClosedTypeFamilyD (TypeFamilyHead n _ _ _) _ -> errorNewName n---               RoleAnnotD _ _ -> undefined -- ???---               StandaloneDerivD ds c -> undefined---               DefaultSigD n t -> undefined -- ???---               -- PatSynD n _ _ _ -> errorNewName n---               -- PatSynSigD n _ _ _ -> errorNewName n---           )

@@ -142,14 +142,6 @@   [d| cata :: Functor f => (f a -> a) -> Fix f -> a       cata f = f . fmap (cata f) . unfix |]   "ana"--- withDual [d| infix 3 `cata` |]---- -- | Where do these docs wind up?--- makeDualDec [d| toMaybe :: forall a. [a] -> Maybe a |] "toList"--- toMaybe (x : _) = Just x--- toMaybe []       = Nothing--- toList (Just x) = [x]--- toList Nothing  = []  -- | Duals for this module. exportDuals "exampleDuals"