universe-th 0.0.0.3 → 0.0.0.6

raw patch · 2 files changed

+36/−18 lines, 2 filesPVP: major bump suggested

API removals or changes: PVP suggests a major version bump

API changes (from Hackage documentation)

Files

• src/Language/Haskell/TH/Universe.hs +35/−17
• universe-th.cabal +1/−1

@@ -24,13 +24,8 @@ import Control.Monad.Reader import Control.Monad.Identity ---TODO fix this so that I have a RWST monad---and write to the monad instead of ---that's how you will get the sub_universe- type Universe = [(Name, Dec)] ---TODO add a reader monad type ErrorStateType m e s a = ErrorT e (StateT s (ReaderT s m)) a  newtype ErrorStateT e s m a = ErrorStateT { runErrorStateT :: ErrorStateType m e s a }@@ -61,17 +56,23 @@  -- | Find the type in the passed in universe of Decs ([Dec]), and all of the ancestors in the universe.   sub_universe :: [Dec] -> Name -> Universe-sub_universe decs name = nub $ snd $ runIdentity $ runReaderT (runStateT (runErrorT (runErrorStateT (sub_universe' name))) []) $ make_dec_dict decs +sub_universe decs name = nub $ snd $ runIdentity $ +    runReaderT (runStateT (runErrorT (runErrorStateT (sub_universe' name))) []) $ +        make_dec_dict decs   make_dec_dict :: [Dec] -> [(Name, Dec)]-make_dec_dict decs = map (\x -> (from_right $ get_dec_name x, x)) decs+make_dec_dict decs = go decs [] where+    go [] output = output+    go (x:xs) output = case (get_dec_name x) of+                         Right n -> (n, x):(go xs output)+                         _ -> go xs output  get_all_decs = do     decs <- get     other_decs <- ask     return $ decs ++ other_decs -sub_universe' :: (Monad m, Functor m,+sub_universe' :: (Monad m, Functor m,  MonadPlus m,     MonadState Universe m,      MonadError String   m,     MonadReader Universe m) => Name -> m ()@@ -104,21 +105,27 @@ create_universe_dec :: Dec -> UniverseState () create_universe_dec dec = create_universe_dec' create_universe_name dec -create_universe_dec' f dec = mapM_ f =<< collect_new_dec_names dec+create_universe_dec' f dec = mapM_ f =<< (collect_new_dec_names dec) -collect_new_dec_names :: (Monad m,+collect_new_dec_names :: (Monad m, MonadPlus m,     MonadState Universe m,      MonadError String   m) => Dec -> m [Name] collect_new_dec_names dec = do     dec_name <- throw_either $ get_dec_name dec      modify ((dec_name, dec):)-    let type_names = collect_dec_type_names dec-    --look them up if haven't looked them up before-    filter_dups type_names     +    if (show dec_name == "GHC.Types.[]")+        then return []+        else do+                let type_names = collect_dec_type_names dec+                --look them up if haven't looked them up before+                filter_dups type_names+      collect_dec_type_names :: Dec -> [Name]-collect_dec_type_names = concatMap get_type_names . nub . concatMap get_con_types . get_cons+collect_dec_type_names (TySynD _ _ typ) = get_type_names typ+collect_dec_type_names x = nub . concatMap get_type_names . concatMap get_con_types $ +                                get_cons x  filter_dups' :: Eq a => [a] -> [(a, b)] -> [a] filter_dups' names uni = names \\ (fst $ unzip uni)@@ -147,11 +154,22 @@ get_con_types (ForallC _ _ con) = get_con_types con  get_type_names :: Type -> [Name]-get_type_names = map (from_right . get_type_name) . get_constr_types+get_type_names typ = go (universe typ) [] where+    go []     output = output+    go (x:xs) output = case type_to_name x of+                        Just y -> y:(go xs output)+                        _ -> go xs output+    +type_to_name :: Type -> Maybe Name+type_to_name (ConT n) = Just n+type_to_name ListT  = Just $ mkName "[]"+type_to_name (TupleT count)= Just $ mkName ("(" ++ +    (concat $ take count (cycle [","])) ++ ")") +type_to_name _ = Nothing -from_right :: Either a b -> b+from_right :: Either String b -> b from_right (Right x) = x-from_right _ = error "from_right"+from_right (Left msg) = error msg  get_type_name' :: Type -> Name get_type_name' = from_right . get_type_name

@@ -7,7 +7,7 @@ -- The package version. See the Haskell package versioning policy -- (http://www.haskell.org/haskellwiki/Package_versioning_policy) for -- standards guiding when and how versions should be incremented.-Version:             0.0.0.3+Version:             0.0.0.6  -- A short (one-line) description of the package. Synopsis:            Construct a Dec's ancestor list.