packages feed

uhc-util 0.1.5.0 → 0.1.5.1

raw patch · 5 files changed

+200/−174 lines, 5 filesdep +fclabelsPVP: major bump suggested

API removals or changes: PVP suggests a major version bump

Dependencies added: fclabels

API changes (from Hackage documentation)

+ UHC.Util.CompileRun2: _crCUCache :: CompileRun nm unit info err -> Map nm unit
+ UHC.Util.CompileRun2: _crCompileOrder :: CompileRun nm unit info err -> [[nm]]
+ UHC.Util.CompileRun2: _crState :: CompileRun nm unit info err -> CompileRunState err
+ UHC.Util.CompileRun2: _crStateInfo :: CompileRun nm unit info err -> info
+ UHC.Util.CompileRun2: _crTopModNm :: CompileRun nm unit info err -> nm
+ UHC.Util.CompileRun2: cpMbCU :: (Ord n, CompileRunner s n p l u i e m) => n -> CompilePhaseT n u i e m (Maybe u)
+ UHC.Util.FPath: instance Constructor C1_0FPath
+ UHC.Util.FPath: instance Datatype D1FPath
+ UHC.Util.FPath: instance Generic FPath
+ UHC.Util.FPath: instance Selector S1_0_0FPath
+ UHC.Util.FPath: instance Selector S1_0_1FPath
+ UHC.Util.FPath: instance Selector S1_0_2FPath
+ UHC.Util.Hashable: instance Hashable FPath
+ UHC.Util.Lens: (=$:) :: MonadState f m => (f :-> o) -> (o -> o) -> m ()
+ UHC.Util.Lens: (=.) :: MonadState f m => Lens (->) f o -> (o -> o) -> m ()
+ UHC.Util.Lens: (=:) :: MonadState f m => Lens (->) f o -> o -> m ()
+ UHC.Util.Lens: (^$=) :: (a :-> b) -> (b -> b) -> a -> a
+ UHC.Util.Lens: (^*) :: (a :-> b) -> (b :-> c) -> (a :-> c)
+ UHC.Util.Lens: (^.) :: a -> (a :-> b) -> b
+ UHC.Util.Lens: (^=) :: (a :-> b) -> b -> a -> a
+ UHC.Util.Lens: focus :: (MonadState a m, MonadState b m) => (a :-> b) -> m c -> m c
+ UHC.Util.Lens: getl :: MonadState f m => (f :-> o) -> m o
+ UHC.Util.Lens: isoMb :: String -> (f :-> Maybe o) -> (f :-> o)
+ UHC.Util.Lens: isoMbWithDefault :: o -> (f :-> Maybe o) -> (f :-> o)
+ UHC.Util.Lens: mkLabel :: Name -> Q [Dec]
+ UHC.Util.Lens: type (:->) f o = Lens Total f o
+ UHC.Util.Lens: type Lens a b = a :-> b
- UHC.Util.CompileRun2: crCUCache :: CompileRun nm unit info err -> Map nm unit
+ UHC.Util.CompileRun2: crCUCache :: ArrowApply cat => Lens cat (CompileRun nm unit info err) (Map nm unit)
- UHC.Util.CompileRun2: crCompileOrder :: CompileRun nm unit info err -> [[nm]]
+ UHC.Util.CompileRun2: crCompileOrder :: ArrowApply cat => Lens cat (CompileRun nm unit info err) [[nm]]
- UHC.Util.CompileRun2: crState :: CompileRun nm unit info err -> CompileRunState err
+ UHC.Util.CompileRun2: crState :: ArrowApply cat => Lens cat (CompileRun nm unit info err -> CompileRun nm unit info a) (CompileRunState err -> CompileRunState a)
- UHC.Util.CompileRun2: crStateInfo :: CompileRun nm unit info err -> info
+ UHC.Util.CompileRun2: crStateInfo :: ArrowApply cat => Lens cat (CompileRun nm unit info err -> CompileRun nm unit a err) (info -> a)
- UHC.Util.CompileRun2: crTopModNm :: CompileRun nm unit info err -> nm
+ UHC.Util.CompileRun2: crTopModNm :: ArrowApply cat => Lens cat (CompileRun nm unit info err) nm
- UHC.Util.FPath: mkTopLevelFPath :: String -> String -> FPath
+ UHC.Util.FPath: mkTopLevelFPath :: String -> FilePath -> FPath

Files

src/UHC/Util/CompileRun2.hs view
@@ -1,4 +1,4 @@-{-# LANGUAGE UndecidableInstances, FlexibleContexts, FlexibleInstances, TypeSynonymInstances, FunctionalDependencies, MultiParamTypeClasses, RankNTypes, ScopedTypeVariables #-}+{-# LANGUAGE TemplateHaskell, UndecidableInstances, FlexibleContexts, FlexibleInstances, TypeSynonymInstances, FunctionalDependencies, MultiParamTypeClasses, RankNTypes, ScopedTypeVariables #-}  ------------------------------------------------------------------------- -- | Combinators for a compile run.@@ -9,7 +9,9 @@   ( CompileRunner    , CompileRunState(..)+     , CompileRun(..)+  , crCUCache, crCompileOrder, crTopModNm, crState, crStateInfo    , CompilePhase   , CompilePhaseT(runCompilePhaseT)@@ -28,10 +30,12 @@    , crCU, crMbCU   , ppCR-+     , cpUpdStateInfo, cpUpdSI    , cpUpdCU, cpUpdCUWithKey+  , cpMbCU+     , cpSetFail, cpSetStop, cpSetStopSeq, cpSetStopAllSeq   , cpSetOk, cpSetErrs, cpSetLimitErrs, cpSetLimitErrsWhen, cpSetInfos, cpSetCompileOrder @@ -60,6 +64,7 @@ import           UHC.Util.Pretty import           UHC.Util.Utils import           UHC.Util.FPath+import           UHC.Util.Lens   -------------------------------------------------------------------------@@ -144,46 +149,6 @@   , Monad m   ) => CompileRunner state nm pos loc unit info err m   where-    -- | Deal with error-    {--    cpHandleErr' :: m a -> m a-    cpHandleErr' m = do-        x <- m-        cr <- get-        let modf f = do {modify f ; return x}-        case crState cr of-          CRSFailErrL about es mbLim-            -> do { let (showErrs,omitErrs) = maybe (es,[]) (flip splitAt es) mbLim-                  ; liftIO (unless (null about) (hPutPPLn stderr (pp about)))-                  ; liftIO $ unless (null showErrs) $ -                           do { hPutPPLn stderr (crePPErrL showErrs)-                              ; unless (null omitErrs) $ hPutStrLn stderr "... and more errors"-                              ; hFlush stderr-                              }-                  ; if creAreFatal es then liftIO exitFailure else modf crSetOk-                  }-          CRSErrInfoL about doPrint is-            -> do { if null is-                    then return x-                    else liftIO (do { hFlush stdout-                                    ; hPutPPLn stderr (about >#< "found errors" >-< e)-                                    ; return x-                                    })-                  ; if not (null is) then liftIO exitFailure else return x-                  }-            where e = empty -- if doPrint then crePPErrL is else empty-          CRSFailMsg msg-            -> do { liftIO $ hPutStrLn stderr msg-                  ; liftIO exitFailure-                  }-          CRSFail-            -> do { liftIO exitFailure-                  }-          CRSStop-            -> do { liftIO $ exitWith ExitSuccess-                  }-          _ -> return x-    -}  ------------------------------------------------------------------------- -- Instances@@ -215,13 +180,15 @@  data CompileRun nm unit info err   = CompileRun-      { crCUCache       :: Map.Map nm unit-      , crCompileOrder  :: [[nm]]-      , crTopModNm      :: nm-      , crState         :: CompileRunState err-      , crStateInfo     :: info+      { _crCUCache       :: Map.Map nm unit+      , _crCompileOrder  :: [[nm]]+      , _crTopModNm      :: nm+      , _crState         :: CompileRunState err+      , _crStateInfo     :: info       } +mkLabel ''CompileRun+ instance Error (CompileRunState err) where   noMsg = CRSOk   strMsg = CRSFailMsg@@ -241,90 +208,17 @@ mkEmptyCompileRun :: n -> i -> CompileRun n u i e mkEmptyCompileRun nm info   = CompileRun-      { crCUCache		= Map.empty-      , crCompileOrder	= []-      , crTopModNm      = nm-      , crState			= CRSOk-      , crStateInfo		= info+      { _crCUCache			= Map.empty+      , _crCompileOrder		= []+      , _crTopModNm      	= nm+      , _crState			= CRSOk+      , _crStateInfo		= info       }  ------------------------------------------------------------------------- -- Monad impl (20140804 AD, not (yet?) put into action, too much code still breaks) ------------------------------------------------------------------------- --- type CompilePhase n u i e a = CompilePhaseT n u i e (StateT (CompileRun n u i e) (ErrorT (CompileRunState e) IO)) a--- type CompilePhase n u i e a = CompilePhase_S_E_IO n u i e a--- type CompilePhase n u i e a = StateT (CompileRun n u i e) IO a--{--type CompilePhase_S_E_T_State n u i e = CompileRun n u i e-type CompilePhase_S_E_T_Error n u i e = CompileRunState e--newtype CompilePhase_S_E_T n u i e m a-  = CompilePhase_S_E_T { runCompilePhase_S_E_T :: StateT (CompilePhase_S_E_T_State n u i e) (ErrorT (CompilePhase_S_E_T_Error n u i e) m) a }--type CompilePhase_S_E_IO n u i e a = CompilePhase_S_E_T n u i e IO a-  -- = CompilePhase_S_E_IO { runCompilePhase_S_E_IO :: StateT (CompilePhase_S_E_IO_State n u i e) (ErrorT (CompilePhase_S_E_IO_Error n u i e) IO) a }--}--{--instance CompileRunError e p => Monad (CompilePhase_S_E_T n u i e IO) where-  return x = CompilePhase_S_E_T $ return x -- \cr -> return (x, cr)-  cp >>= f = CompilePhase_S_E_T $ do -- \cr1 -> do-        x <- runCompilePhase_S_E_T cp -- (x,cr2) <- runCompilePhase_S_E_T cp cr1-        let modf f = do {modify f ; return x}-        cr <- get-        case crState cr of-          CRSFailErrL about es mbLim-            -> do { let (showErrs,omitErrs) = maybe (es,[]) (flip splitAt es) mbLim-                  ; liftIO (unless (null about) (hPutPPLn stderr (pp about)))-                  ; liftIO $ unless (null showErrs) $ -                           do { hPutPPLn stderr (crePPErrL showErrs)-                              ; unless (null omitErrs) $ hPutStrLn stderr "... and more errors"-                              ; hFlush stderr-                              }-                  ; if creAreFatal es then liftIO exitFailure else modf crSetOk-                  }-          CRSErrInfoL about doPrint is-            -> do { if null is-                    then return x-                    else liftIO (do { hFlush stdout-                                    ; hPutPPLn stderr (about >#< "found errors" >-< e)-                                    ; return x-                                    })-                  ; if not (null is) then liftIO exitFailure else return x-                  }-            where e = empty -- if doPrint then crePPErrL is else empty-          CRSFailMsg msg-            -> do { liftIO $ hPutStrLn stderr msg-                  ; liftIO exitFailure-                  }-          CRSFail-            -> do { liftIO exitFailure-                  }-          CRSStop-            -> do { liftIO $ exitWith ExitSuccess-                  }-          _ -> return x-        cr <- get-        case crState cr of-          CRSOk         -> runCompilePhase_S_E_T (f x)-          CRSStopSeq    -> do { modf crSetOk ; ME.throwError CRSStopSeq }-          CRSStopAllSeq -> do { modf crSetStopAllSeq ; ME.throwError CRSStopAllSeq }-          crs           -> ME.throwError crs--instance CompileRunError e p => MonadIO (CompilePhase_S_E_T n u i e IO) where-  liftIO = CompilePhase_S_E_T . liftIO--instance MonadTrans (CompilePhase_S_E_T n u i e) where-  lift = CompilePhase_S_E_T . lift . lift--instance CompileRunError e p => MonadState (CompilePhase_S_E_T_State n u i e) (CompilePhase_S_E_T n u i e IO) where-  get = CompilePhase_S_E_T get-  put = CompilePhase_S_E_T . put---}- -- | 'CompileRun' as state in specific StateT variant with non standard >>= -- newtype CompilePhaseT n u i e m a = CompilePhaseT {runCompilePhaseT :: CompileRun n u i e -> m (a, CompileRun n u i e)} newtype CompilePhaseT n u i e m a@@ -347,7 +241,7 @@         x <- {- cpHandleErr' $ -} runCompilePhaseT cp -- (x,cr2) <- runCompilePhaseT cp cr1         let modf f = do {modify f ; return x}         cr <- get-        case crState cr of+        case _crState cr of           CRSFailErrL about es mbLim             -> do { let (showErrs,omitErrs) = maybe (es,[]) (flip splitAt es) mbLim                   ; liftIO (unless (null about) (hPutPPLn stderr (pp about)))@@ -380,13 +274,13 @@                   }           _ -> return x         cr <- get-        case crState cr of+        case _crState cr of           CRSOk         -> runCompilePhaseT (f x)           CRSStopSeq    -> do { modf crSetOk ; return $ panic "Monad.CompilePhaseT.CRSStopSeq" }           CRSStopAllSeq -> do { modf crSetStopAllSeq ; return $ panic "Monad.CompilePhaseT.CRSStopAllSeq" }           crs           -> return $ panic "Monad.CompilePhaseT._" {-        -        case crState cr of+        case _crState cr of           CRSOk         -> runCompilePhaseT (f x)           CRSStopSeq    -> do { modf crSetOk ; ME.throwError CRSStopSeq }           CRSStopAllSeq -> do { modf crSetStopAllSeq ; ME.throwError CRSStopAllSeq }@@ -432,9 +326,9 @@  ppCR :: (PP n,PP u) => CompileRun n u i e -> PP_Doc ppCR cr-  = "CR" >#< show (crState cr) >|< ":" >#<-      (   (ppBracketsCommasBlock $ map (\(n,u) -> pp n >#< "->" >#< pp u) $ Map.toList $ crCUCache $ cr)-      >-< ppBracketsCommas (map ppBracketsCommas $ crCompileOrder $ cr)+  = "CR" >#< show (_crState cr) >|< ":" >#<+      (   (ppBracketsCommasBlock $ map (\(n,u) -> pp n >#< "->" >#< pp u) $ Map.toList $ _crCUCache cr)+      >-< ppBracketsCommas (map ppBracketsCommas $ _crCompileOrder $ cr)       )  crPP :: (PP n,PP u) => String -> CompileRun n u i e -> IO (CompileRun n u i e)@@ -465,7 +359,7 @@ -------------------------------------------------------------------------  crMbCU :: Ord n => n -> CompileRun n u i e -> Maybe u-crMbCU modNm cr = Map.lookup modNm (crCUCache cr)+crMbCU modNm cr = Map.lookup modNm (_crCUCache cr)  crCU :: (Show n,Ord n) => n -> CompileRun n u i e -> u crCU modNm = panicJust ("crCU: " ++ show modNm) . crMbCU modNm@@ -475,31 +369,31 @@ -------------------------------------------------------------------------  crSetOk :: CompileRun n u i e -> CompileRun n u i e-crSetOk cr = cr {crState = CRSOk}+crSetOk = crState ^= CRSOk -- cr {_crState = CRSOk}  crSetFail :: CompileRun n u i e -> CompileRun n u i e-crSetFail cr = cr {crState = CRSFail}+crSetFail = crState ^= CRSFail -- cr {_crState = CRSFail}  crSetStop :: CompileRun n u i e -> CompileRun n u i e-crSetStop cr = cr {crState = CRSStop}+crSetStop = crState ^= CRSStop -- cr {_crState = CRSStop}  crSetStopSeq :: CompileRun n u i e -> CompileRun n u i e-crSetStopSeq cr = cr {crState = CRSStopSeq}+crSetStopSeq = crState ^= CRSStopSeq -- cr {_crState = CRSStopSeq}  crSetStopAllSeq :: CompileRun n u i e -> CompileRun n u i e-crSetStopAllSeq cr = cr {crState = CRSStopAllSeq}+crSetStopAllSeq = crState ^= CRSStopAllSeq -- cr {_crState = CRSStopAllSeq}  crSetErrs' :: Maybe Int -> String -> [e] -> CompileRun n u i e -> CompileRun n u i e crSetErrs' limit about es cr   = case es of       [] -> cr-      _  -> cr {crState = CRSFailErrL about es limit}+      _  -> cr {_crState = CRSFailErrL about es limit}  crSetInfos' :: String -> Bool -> [e] -> CompileRun n u i e -> CompileRun n u i e crSetInfos' msg dp is cr   = case is of       [] -> cr-      _  -> cr {crState = CRSErrInfoL msg dp is}+      _  -> cr {_crState = CRSErrInfoL msg dp is}  ------------------------------------------------------------------------- -- Compile unit observations@@ -539,7 +433,7 @@                                        )                   ; case fpsFound of                       []-                        -> do { cpSetErrs (creMkNotFoundErrL (crsiImportPosOfCUKey modNm (crStateInfo cr)) (fpathToStr fp) (map show locs) suffs')+                        -> do { cpSetErrs (creMkNotFoundErrL (crsiImportPosOfCUKey modNm (_crStateInfo cr)) (fpathToStr fp) (map show locs) suffs')                               ; return []                               }                       ((_,_,e@(_:_)):_)@@ -630,10 +524,10 @@       [modNm]  crImportDepL :: (CompileUnit u n l s) => CompileRun n u i e -> [(n,[n])]-crImportDepL = map (\cu -> (cuKey cu,cuImports cu)) . Map.elems . crCUCache+crImportDepL = map (\cu -> (cuKey cu,cuImports cu)) . Map.elems . _crCUCache  cpImportScc :: (Ord n, CompileRunner s n p l u i e m) => CompilePhaseT n u i e m ()-cpImportScc = modify (\cr -> (cr {crCompileOrder = scc (crImportDepL cr)}))+cpImportScc = modify (\cr -> (cr {_crCompileOrder = scc (crImportDepL cr)}))   -------------------------------------------------------------------------@@ -641,10 +535,12 @@ -------------------------------------------------------------------------  cpUpdStateInfo, cpUpdSI :: CompileRunner s n p l u i e m => (i -> i) -> CompilePhaseT n u i e m ()-cpUpdStateInfo upd+cpUpdStateInfo upd = crStateInfo =$: upd+{-   = do { cr <- get-       ; put (cr {crStateInfo = upd (crStateInfo cr)})+       ; put (cr {_crStateInfo = upd (_crStateInfo cr)})        }+-}  cpUpdSI = cpUpdStateInfo @@ -655,8 +551,8 @@ cpUpdCUM :: (Ord n, CompileRunner s n p l u i e m) => n -> (u -> IO u) -> CompilePhaseT n u i e m () cpUpdCUM modNm upd   = do { cr <- get-       ; cu <- liftIO (maybe (upd cuDefault) upd (crMbCU modNm cr))-       ; put (cr {crCUCache = Map.insert modNm cu (crCUCache cr)})+       ; cu <- liftIO $ maybe (upd cuDefault) upd (crMbCU modNm cr)+       ; crCUCache =$: Map.insert modNm cu        }  @@ -664,7 +560,7 @@ cpUpdCUWithKey modNm upd   = do { cr <- get        ; let (modNm',cu) = (maybe (upd modNm cuDefault) (upd modNm) (crMbCU modNm cr))-       ; put (cr {crCUCache = Map.insert modNm' cu $ Map.delete modNm $ crCUCache cr})+       ; crCUCache =$: Map.insert modNm' cu . Map.delete modNm        ; return modNm'        } @@ -674,21 +570,13 @@        ; return ()        } +-- | lookup unit+cpMbCU :: (Ord n,CompileRunner s n p l u i e m) => n -> CompilePhaseT n u i e m (Maybe u)+cpMbCU modNm = liftM (crMbCU modNm) get+ -- | delete unit cpDelCU :: (Ord n,CompileRunner s n p l u i e m) => n -> CompilePhaseT n u i e m ()-cpDelCU modNm-  = do { modify (\cr -> cr {crCUCache = Map.delete modNm $ crCUCache cr})-       }-{--  = do { cr <- get-       ; let cu = (maybe (upd cuDefault) upd (crMbCU modNm cr))-       ; put (cr {crCUCache = Map.insert modNm cu (crCUCache cr)})-       }--}-{--cpUpdCU modNm upd- = cpUpdCUM modNm (return . upd)--}+cpDelCU modNm = crCUCache =$: Map.delete modNm  ------------------------------------------------------------------------- -- State manipulation, sequencing (Monadic)@@ -719,12 +607,12 @@  = modify crSetStopAllSeq  cpSetOk :: CompileRunner s n p l u i e m => CompilePhaseT n u i e m ()-cpSetOk- = modify (\cr -> (cr {crState = CRSOk}))+cpSetOk = crState =: CRSOk+ -- = modify (\cr -> (cr {_crState = CRSOk}))  cpSetCompileOrder :: CompileRunner s n p l u i e m => [[n]] -> CompilePhaseT n u i e m ()-cpSetCompileOrder nameLL- = modify (\cr -> (cr {crCompileOrder = nameLL}))+cpSetCompileOrder nameLL = crCompileOrder =: nameLL+ -- = modify (\cr -> (cr {_crCompileOrder = nameLL}))  cpSetLimitErrs, cpSetLimitErrsWhen :: CompileRunner s n p l u i e m => Int -> String -> [e] -> CompilePhaseT n u i e m () cpSetLimitErrs l a e@@ -748,7 +636,7 @@ cpSeq (a:as) = do { a                   ; cpHandleErr                   ; cr <- get-                  ; case crState cr of+                  ; case _crState cr of                       CRSOk         -> cpSeq as                       CRSStopSeq    -> cpSetOk                       CRSStopAllSeq -> cpSetStopAllSeq@@ -766,7 +654,7 @@ cpHandleErr :: CompileRunError e p => CompilePhase n u i e () cpHandleErr   = do { cr <- get-       ; case crState cr of+       ; case _crState cr of            CRSFailErrL about es (Just lim)              -> do { let (showErrs,omitErrs) = splitAt lim es                    ; liftIO (unless (null about) (hPutPPLn stderr (pp about)))
src/UHC/Util/FPath.hs view
@@ -59,6 +59,8 @@ import System.IO import System.Directory +import GHC.Generics+ import UHC.Util.Utils import UHC.Util.Time @@ -109,7 +111,7 @@       , fpathBase       ::         !String       , fpathMbSuff     :: !(Maybe  String)       }-    deriving (Show,Eq,Ord)+    deriving (Show,Eq,Ord,Generic)  -- | Empty FPath emptyFPath :: FPath@@ -248,10 +250,14 @@ mkFPathFromDirsFile dirs f   = fpathSetDir (concat $ intersperse fpathDirSep $ map show $ dirs) (mkFPath (show f)) -mkTopLevelFPath :: String -> String -> FPath+-- | Make FPath from FilePath, setting the suffix when absent+mkTopLevelFPath+  :: String		-- ^ suffix+  -> FilePath	-- ^ file name+  -> FPath mkTopLevelFPath suff fn   = let fpNoSuff = mkFPath fn-     in maybe (fpathSetSuff suff fpNoSuff) (const fpNoSuff) . fpathMbSuff $ fpNoSuff+     in maybe (fpathSetSuff suff fpNoSuff) (const fpNoSuff) $ fpathMbSuff fpNoSuff  ------------------------------------------------------------------------------------------- -- Utils
+ src/UHC/Util/Hashable.hs view
@@ -0,0 +1,15 @@+{-| Re-export of hashable package,+    in addition providing some of the instances for datatypes defined in the remainder of the uhc-util package.+-}++module UHC.Util.Hashable+  ( module Data.Hashable+  )+  where++import Data.Hashable+import UHC.Util.FPath++-- Instances++instance Hashable FPath
+ src/UHC/Util/Lens.hs view
@@ -0,0 +1,114 @@+{-| Minimal redefine + re-export of a lens package, fclabels currently.+    in addition providing some of the instances for datatypes defined in the remainder of the uhc-util package.+-}++{-# LANGUAGE TypeOperators #-}++module UHC.Util.Lens+  ( (:->)+  , Lens++  -- * Access+  +  , (^*)++  , (^.)+  , (^=)+  , (^$=)+  +  , (=.)+  , (=:)+  , (=$:)+  , getl+  +  -- * Misc+  +  , focus+  +  , mkLabel+  +  -- * Wrappers+  +  , isoMb+  , isoMbWithDefault++  )+  where++import           Prelude hiding ((.), id)+import qualified Control.Monad.State as MS+import           Control.Monad.Trans+import           Control.Category++import           Data.Label hiding (Lens)+import           Data.Label.Monadic((=:), (=.))+import qualified Data.Label.Monadic as M+import qualified Data.Label.Partial as P++import           UHC.Util.Utils++-- * Textual alias for (:->)+type Lens a b = a :-> b++-- * Operator interface for composition++infixl 9 ^*+-- | functional getter, which acts like a field accessor+(^*) :: (a :-> b) -> (b :-> c) -> (a :-> c)+f1 ^* f2 = f2 . f1+{-# INLINE (^*) #-}+++-- * Operator interface for functional part (occasionally similar to Data.Lens)++infixl 8 ^.+-- | functional getter, which acts like a field accessor+(^.) :: a -> (a :-> b) -> b+a ^. f = get f a+{-# INLINE (^.) #-}++infixr 4 ^=+-- | functional setter, which acts like a field assigner+(^=) :: (a :-> b) -> b -> a -> a+(^=) = set+{-# INLINE (^=) #-}++infixr 4 ^$=+-- | functional modify+(^$=) :: (a :-> b) -> (b -> b) -> a -> a+(^$=) = modify+{-# INLINE (^$=) #-}++-- * Operator interface for monadic part (occasionally similar to Data.Lens)++infixr 4 =$:+-- | monadic modify & set+(=$:) :: MS.MonadState f m => (f :-> o) -> (o -> o) -> m ()+(=$:) = M.modify+{-# INLINE (=$:) #-}++focus :: (MS.MonadState a m, MS.MonadState b m) => (a :-> b) -> m c -> m c+focus f m = do+  a <- MS.get+  (b,c) <- do {MS.put (get f a) ; c <- m ; b <- MS.get ; return (b,c)}+  MS.put $ set f b a+  return c+  +{-+ (Lens f) (StateT g) = StateT $ \a -> case f a of+  StoreT (Identity h) b -> liftM (second h) (g b)+-}++-- | Alias for 'gets' avoiding conflict with MonadState+getl :: MS.MonadState f m => (f :-> o) -> m o+getl = M.gets++-- * Wrappers++-- | Wrapper around a Maybe with a default in case of Nothing+isoMbWithDefault :: o -> (f :-> Maybe o) -> (f :-> o)+isoMbWithDefault dflt f = iso (Iso (maybe dflt id) (Just)) . f++-- | Wrapper around a Maybe with an embedded panic in case of Nothing, with a panic message+isoMb :: String -> (f :-> Maybe o) -> (f :-> o)+isoMb msg f = iso (Iso (panicJust msg) (Just)) . f
uhc-util.cabal view
@@ -1,5 +1,5 @@ Name:				uhc-util-Version:			0.1.5.0+Version:			0.1.5.1 cabal-version:      >= 1.6 License:			BSD3 Copyright:			Utrecht University, Department of Information and Computing Sciences, Software Technology group@@ -7,15 +7,15 @@ license-file:		LICENSE  Author:				Atze Dijkstra Maintainer:         atze@uu.nl-Homepage:           https://github.com/UU-ComputerScience/uhc-utils-Bug-Reports:        https://github.com/UU-ComputerScience/uhc-utils/issues+Homepage:           https://github.com/UU-ComputerScience/uhc-util+Bug-Reports:        https://github.com/UU-ComputerScience/uhc-util/issues Category:			Development Description:		General purpose utilities for UHC and related tools Synopsis:			UHC utilities  source-repository head   type:     git-  location: git://github.com/UU-ComputerScience/uhc-utils.git+  location: git://github.com/UU-ComputerScience/uhc-util.git  library   Build-Depends:@@ -33,6 +33,7 @@     time-compat >= 0.1.0.1,     time >= 1.2,     ListLike >= 4.0.0,+    fclabels >= 2.0.2,     syb  >= 0.3.6   Exposed-Modules:     UHC.Util.AGraph,@@ -45,6 +46,8 @@     UHC.Util.DependencyGraph,     UHC.Util.FastSeq,     UHC.Util.FPath,+    UHC.Util.Hashable,+    UHC.Util.Lens,     UHC.Util.Nm,     UHC.Util.ParseErrPrettyPrint,     UHC.Util.ParseUtils,@@ -63,4 +66,4 @@   Ghc-Options:		   HS-Source-Dirs:     	src   Build-Tools:		-  Extensions: NoMagicHash		+  Extensions: NoMagicHash, DeriveGeneric