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 +54/−166
- src/UHC/Util/FPath.hs +9/−3
- src/UHC/Util/Hashable.hs +15/−0
- src/UHC/Util/Lens.hs +114/−0
- uhc-util.cabal +8/−5
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