-- Hoogle documentation, generated by Haddock -- See Hoogle, http://www.haskell.org/hoogle/ -- | Haskus utility modules -- -- Haskus utility modules. @package haskus-utils @version 1.1 -- | Embed data into the executable binary module Haskus.Utils.Embed -- | Embed bytes in a C array, return an Addr# embedBytes :: [Word8] -> Q Exp -- | Adapted from the raw-strings-qq package (BSD3) -- -- A quasiquoter for raw string literals - that is, string literals that -- don't recognise the standard escape sequences (such as '\n'). -- Basically, they make your code more readable by freeing you from the -- responsibility to escape backslashes. They are useful when working -- with regular expressions, DOS/Windows paths and markup languages (such -- as XML). -- -- Don't forget the LANGUAGE QuasiQuotes pragma if you're using -- this module in your code. -- -- Usage: -- --
-- ghci> :set -XQuasiQuotes
-- ghci> import Text.RawString.QQ
-- ghci> let s = [raw|\w+@[a-zA-Z_]+?\.[a-zA-Z]{2,3}|]
-- ghci> s
-- "\\w+@[a-zA-Z_]+?\\.[a-zA-Z]{2,3}"
-- ghci> [raw|C:\Windows\SYSTEM|] ++ [raw|\user32.dll|]
-- "C:\\Windows\\SYSTEM\\user32.dll"
--
--
-- Multiline raw string literals are also supported:
--
-- -- multiline :: String -- multiline = [raw|<HTML> -- <HEAD> -- <TITLE>Auto-generated html formated source</TITLE> -- <META HTTP-EQUIV="Content-Type" CONTENT="text/html; charset=windows-1252"> -- </HEAD> -- <BODY LINK="800080" BGCOLOR="#ffffff"> -- <P> </P> -- <PRE>|] ---- -- Caveat: since the "|]" character sequence is used to -- terminate the quasiquotation, you can't use it inside the raw string -- literal. Use rawQ if you want to embed that character sequence -- inside the raw string. raw :: QuasiQuoter -- | A variant of raw that interprets the "|~]" sequence as -- "|]", "|~~]" as "|~]" and, in general, -- "|~^n]" as "|~^(n-1)]" for n >= 1. -- -- Usage: -- --
-- ghci> [rawQ||~]|~]|] -- "|]|]" -- ghci> [rawQ||~~]|] -- "|~]" -- ghci> [rawQ||~~~~]|] -- "|~~~]" --rawQ :: QuasiQuoter -- | Control-flow module Haskus.Utils.Flow -- | Monads in which IO computations may be embedded. Any monad -- built by applying a sequence of monad transformers to the IO -- monad will be an instance of this class. -- -- Instances should satisfy the following laws, which state that -- liftIO is a transformer of monads: -- -- class Monad m => MonadIO (m :: * -> *) -- | Lift a computation from the IO monad. liftIO :: MonadIO m => IO a -> m a class MonadIO m => MonadInIO (m :: * -> *) -- | Lift with*-like functions into IO (alloca, etc.) liftWith :: MonadInIO m => forall c. () => a -> IO c -> IO c -> a -> m b -> m b -- | Lift with*-like functions into IO (alloca, etc.) liftWith2 :: MonadInIO m => forall c. () => a -> b -> IO c -> IO c -> a -> b -> m e -> m e -- | Apply a function (|>) :: a -> (a -> b) -> b infixl 0 |> -- | Apply a function (<|) :: (a -> b) -> a -> b infixr 0 <| -- | Apply a function in a Functor (||>) :: Functor f => f a -> (a -> b) -> f b infixl 0 ||> -- | Apply a function in a Functor (<||) :: Functor f => (a -> b) -> f a -> f b infixr 0 <|| -- | Conditional execution of Applicative expressions. For example, -- --
-- when debug (putStrLn "Debugging") ---- -- will output the string Debugging if the Boolean value -- debug is True, and otherwise do nothing. when :: Applicative f => Bool -> f () -> f () -- | The reverse of when. unless :: Applicative f => Bool -> f () -> f () -- | Like when, but where the test can be monadic. whenM :: Monad m => m Bool -> m () -> m () -- | Like unless, but where the test can be monadic. unlessM :: Monad m => m Bool -> m () -> m () -- | Like if, but where the test can be monadic. ifM :: Monad m => m Bool -> m a -> m a -> m a -- | Conditional failure of Alternative computations. Defined by -- --
-- guard True = pure () -- guard False = empty ---- --
-- >>> safeDiv 4 0 -- Nothing -- >>> safeDiv 4 2 -- Just 2 ---- -- A definition of safeDiv using guards, but not guard: -- --
-- safeDiv :: Int -> Int -> Maybe Int -- safeDiv x y | y /= 0 = Just (x `div` y) -- | otherwise = Nothing ---- -- A definition of safeDiv using guard and Monad -- do-notation: -- --
-- safeDiv :: Int -> Int -> Maybe Int -- safeDiv x y = do -- guard (y /= 0) -- return (x `div` y) --guard :: Alternative f => Bool -> f () -- | void value discards or ignores the result of -- evaluation, such as the return value of an IO action. -- --
-- >>> void Nothing -- Nothing -- -- >>> void (Just 3) -- Just () ---- -- Replace the contents of an Either Int -- Int with unit, resulting in an Either -- Int '()': -- --
-- >>> void (Left 8675309) -- Left 8675309 -- -- >>> void (Right 8675309) -- Right () ---- -- Replace every element of a list with unit: -- --
-- >>> void [1,2,3] -- [(),(),()] ---- -- Replace the second element of a pair with unit: -- --
-- >>> void (1,2) -- (1,()) ---- -- Discard the result of an IO action: -- --
-- >>> mapM print [1,2] -- 1 -- 2 -- [(),()] -- -- >>> void $ mapM print [1,2] -- 1 -- 2 --void :: Functor f => f a -> f () -- | forever act repeats the action infinitely. forever :: Applicative f => f a -> f b -- | The foldM function is analogous to foldl, except that -- its result is encapsulated in a monad. Note that foldM works -- from left-to-right over the list arguments. This could be an issue -- where (>>) and the `folded function' are not -- commutative. -- --
-- foldM f a1 [x1, x2, ..., xm] -- -- == -- -- do -- a2 <- f a1 x1 -- a3 <- f a2 x2 -- ... -- f am xm ---- -- If right-to-left evaluation is required, the input list should be -- reversed. -- -- Note: foldM is the same as foldlM foldM :: (Foldable t, Monad m) => b -> a -> m b -> b -> t a -> m b -- | Like foldM, but discards the result. foldM_ :: (Foldable t, Monad m) => b -> a -> m b -> b -> t a -> m () -- | forM is mapM with its arguments flipped. For a version -- that ignores the results see forM_. forM :: (Traversable t, Monad m) => t a -> a -> m b -> m t b -- | forM_ is mapM_ with its arguments flipped. For a version -- that doesn't ignore the results see forM. -- -- As of base 4.8.0.0, forM_ is just for_, specialized to -- Monad. forM_ :: (Foldable t, Monad m) => t a -> a -> m b -> m () -- | Map each element of a structure to a monadic action, evaluate these -- actions from left to right, and collect the results. For a version -- that ignores the results see mapM_. mapM :: (Traversable t, Monad m) => a -> m b -> t a -> m t b -- | Map each element of a structure to a monadic action, evaluate these -- actions from left to right, and ignore the results. For a version that -- doesn't ignore the results see mapM. -- -- As of base 4.8.0.0, mapM_ is just traverse_, specialized -- to Monad. mapM_ :: (Foldable t, Monad m) => a -> m b -> t a -> m () -- | Evaluate each monadic action in the structure from left to right, and -- collect the results. For a version that ignores the results see -- sequence_. sequence :: (Traversable t, Monad m) => t m a -> m t a -- | replicateM n act performs the action n times, -- gathering the results. replicateM :: Applicative m => Int -> m a -> m [a] -- | Like replicateM, but discards the result. replicateM_ :: Applicative m => Int -> m a -> m () -- | This generalizes the list-based filter function. filterM :: Applicative m => a -> m Bool -> [a] -> m [a] -- | The join function is the conventional monad join operator. It -- is used to remove one level of monadic structure, projecting its bound -- argument into the outer level. join :: Monad m => m m a -> m a -- | Right-to-left Kleisli composition of monads. -- (>=>), with the arguments flipped. -- -- Note how this operator resembles function composition -- (.): -- --
-- (.) :: (b -> c) -> (a -> b) -> a -> c -- (<=<) :: Monad m => (b -> m c) -> (a -> m b) -> a -> m c --(<=<) :: Monad m => b -> m c -> a -> m b -> a -> m c infixr 1 <=< -- | Left-to-right Kleisli composition of monads. (>=>) :: Monad m => a -> m b -> b -> m c -> a -> m c infixr 1 >=> -- | A monadic version of loop, where the predicate returns -- Left as a seed for the next loop or Right to abort the -- loop. loopM :: Monad m => a -> m Either a b -> a -> m b -- | Keep running an operation until it becomes False. As an -- example: -- --
-- whileM $ do sleep 0.1; notM $ doesFileExist "foo.txt" -- readFile "foo.txt" ---- -- If you need some state persisted between each test, use loopM. whileM :: Monad m => m Bool -> m () -- | Heterogeneous array: like a HList but indexed in O(1) module Haskus.Utils.HArray -- | heterogeneous array data HArray (types :: [*]) -- | The type t with index n is indexable in the array type HArrayIndex (n :: Nat) t (ts :: [*]) = (KnownNat n, t ~ Index n ts, KnownNat (Length ts), CmpNat n (Length ts) ~ 'LT) -- | A type t is indexable in the array type HArrayIndexT t (ts :: [*]) = (IsMember t ts ~ 'True, HArrayIndex (IndexOf t ts) t ts) -- | A type t is maybe indexable in the array type HArrayTryIndexT t (ts :: [*]) = (HArrayIndex (MaybeIndexOf t ts) t (t : ts)) -- | Empty array emptyHArray :: HArray '[] -- | Empty array singleHArray :: a -> HArray '[a] -- | Get an element by index getHArrayN :: forall (n :: Nat) (ts :: [*]) t. (HArrayIndex n t ts) => HArray ts -> t -- | Get first element getHArray0 :: (HArrayIndex 0 t ts) => HArray ts -> t -- | Set an element by index setHArrayN :: forall (n :: Nat) (ts :: [*]) t. (HArrayIndex n t ts) => t -> HArray ts -> HArray ts -- | Get an element by type (select the first one with this type) getHArrayT :: forall t ts. (HArrayIndexT t ts) => HArray ts -> t -- | Set an element by type (select the first one with this type) setHArrayT :: forall t ts. (HArrayIndexT t ts) => t -> HArray ts -> HArray ts -- | Get an element by type (select the first one with this type) tryGetHArrayT :: forall t ts. (HArrayTryIndexT t ts) => HArray ts -> Maybe t -- | Append a value to an array (O(n)) appendHArray :: HArray ts -> t -> HArray (Snoc ts t) -- | Prepend a value to an array (O(n)) prependHArray :: t -> HArray ts -> HArray (t : ts) -- | Concat arrays concatHArray :: HArray ts1 -> HArray ts2 -> HArray (Concat ts1 ts2) -- | Drop the last element initHArray :: HArray ts -> HArray (Init ts) -- | Drop the first element tailHArray :: HArray ts -> HArray (Tail ts) newtype HArrayT m xs ys HArrayT :: HArray xs -> m (HArray ys) -> HArrayT m xs ys [runHArrayT] :: HArrayT m xs ys -> HArray xs -> m (HArray ys) -- | Compose HArrayT (>~:~>) :: (Monad m) => HArrayT m xs ys -> HArrayT m ys zs -> HArrayT m xs zs -- | State monad with multiple states (extensible) -- -- Similar to the multistate package, with the following differences (as -- of 0.7.0.0): * don't pollute Data.HList.HList * use HArray instead of -- a HList, for fast indexing module Haskus.Utils.MultiState -- | Multi-state monad transformer -- -- States are stacked in a heterogeneous array. type MStateT (s :: [*]) m a = StateT (HArray s) m a -- | Multi-state type MState (s :: [*]) a = MStateT s Identity a -- | Set a value in the state mSet :: (Monad m, HArrayIndexT a s) => a -> MStateT s m () -- | Get a value in the state mGet :: (Monad m, HArrayIndexT a s) => MStateT s m a -- | Try to get a value in the state mTryGet :: (Monad m, HArrayTryIndexT a s) => MStateT s m (Maybe a) -- | Modify a value in the state mModify :: (Monad m, HArrayIndexT a s) => (a -> a) -> MStateT s m () -- | Modify a value in the state (strict version) mModify' :: (Monad m, HArrayIndexT a s) => (a -> a) -> MStateT s m () -- | Execute an action with an extended state mWith :: forall s a m b. (Monad m) => a -> MStateT (a : s) m b -> MStateT s m b -- | Run MState runMState :: MState s a -> HArray s -> (a, HArray s) -- | Evaluate MState evalMState :: MState s a -> HArray s -> a -- | Execute MState execMState :: MState s a -> HArray s -> HArray s -- | Lift a multi-state into an HArray transformer liftMStateT :: (Monad m) => MStateT xs m x -> HArrayT m xs (x : xs) -- | Compose MStateT (>~:>) :: (Monad m) => HArrayT m xs ys -> MStateT ys m y -> HArrayT m xs (y : ys) -- | Compose MStateT (>:>) :: (Monad m) => MStateT xs m x -> MStateT (x : xs) m y -> HArrayT m xs (y : x : xs) -- | Tools to write parsers using Flows module Haskus.Utils.Parser -- | Parser error data ParseError SyntaxError :: ParseError EndOfInput :: ParseError data Choice a Choice :: Choice a -- | Try to apply the actions in the list in order, until one of them -- succeeds. Returns the value of the succeeding action, or the value of -- the last one. Failures are detected with values of type -- ParseError. choice :: forall m fs zs. (Monad m, HFoldl (Choice ParseError) (Flow m '[ParseError]) fs (Flow m zs)) => HList fs -> Flow m zs -- | Try to apply the actions in the list in order, until one of them -- succeeds. Returns the value of the succeeding action, or the value of -- the last one. Failures are detected with values of type "a". choice' :: forall a m fs zs. (Monad m, HFoldl (Choice a) (Flow m '[a]) fs (Flow m zs)) => HList fs -> Flow m zs -- | Apply the given action at least min times and at most -- max time -- -- On failure, fails. manyBounded :: forall zs xs m. (zs ~ Filter ParseError xs, Monad m, ParseError : xs) => Maybe Word -> Maybe Word -> Flow m xs -> Flow m '[[V zs], ParseError] -- | Apply the action zero or more times (up to max) until a ParseError -- result is returned manyAtMost :: (zs ~ Filter ParseError xs, Monad m, ParseError :< xs) => Word -> Flow m xs -> Flow m '[[V zs]] -- | Apply the action zero or more times (up to max) until a ParseError -- result is returned manyAtMost' :: (zs ~ Filter ParseError xs, Monad m, ParseError :< xs) => Word -> Flow m xs -> m [V zs] -- | Apply the action zero or more times (up to max) until a ParseError -- result is returned manyAtMost'' :: ('[x] ~ Filter ParseError xs, Monad m, ParseError :< xs) => Word -> Flow m xs -> m [x] -- | Apply the action zero or more times (until a ParseError result is -- returned) many :: (zs ~ Filter ParseError xs, Monad m, ParseError :< xs) => Flow m xs -> Flow m '[[V zs]] -- | Apply the action at least n times or more times (until a ParseError -- result is returned) manyAtLeast :: (zs ~ Filter ParseError xs, Monad m, ParseError :< xs) => Word -> Flow m xs -> Flow m '[[V zs], ParseError] -- | Apply the first action zero or more times until the second succeeds. -- If the first action fails, the whole operation fails. -- -- Return both the list of first values and the ending value manyTill :: (zs ~ Filter ParseError xs, zs' ~ Filter ParseError ys, Monad m, ParseError : xs, ParseError :< ys) => Flow m xs -> Flow m ys -> Flow m '[([V zs], V zs'), ParseError] -- | Apply the first action zero or more times until the second succeeds. -- If the first action fails, the whole operation fails. -- -- Return only the list of first values manyTill' :: (zs ~ Filter ParseError xs, Monad m, ParseError : xs, ParseError :< ys) => Flow m xs -> Flow m ys -> Flow m '[[V zs], ParseError] instance GHC.Classes.Eq Haskus.Utils.Parser.ParseError instance GHC.Show.Show Haskus.Utils.Parser.ParseError instance (x ~ Haskus.Utils.Variant.Flow.Flow m xs, y ~ Haskus.Utils.Variant.Flow.Flow m ys, z ~ Haskus.Utils.Variant.Flow.Flow m zs, a Haskus.Utils.Variant.:< xs, Haskus.Utils.Variant.Liftable ys zs, Haskus.Utils.Variant.Liftable (Haskus.Utils.Types.List.Filter a xs) zs, zs ~ Haskus.Utils.Types.List.Union (Haskus.Utils.Types.List.Filter a xs) ys, GHC.Base.Monad m) => Haskus.Utils.HList.Apply (Haskus.Utils.Parser.Choice a) (x, y) z -- | STM helpers module Haskus.Utils.STM -- | A monad supporting atomic memory transactions. data STM a -- | Retry execution of the current memory transaction because it has seen -- values in TVars which mean that it should not continue (e.g. -- the TVars represent a shared buffer that is now empty). The -- implementation may block the thread until one of the TVars that -- it has read from has been updated. (GHC only) retry :: () => STM a -- | Execute an STM transaction atomically atomically :: MonadIO m => STM a -> m a -- | Shared memory locations that support atomic memory transactions. data TVar a -- | Create a TVar newTVarIO :: MonadIO m => a -> m (TVar a) -- | Read a TVar in an IO monad readTVarIO :: MonadIO m => TVar a -> m a -- | Write the supplied value into a TVar. writeTVar :: () => TVar a -> a -> STM () -- | Return the current value stored in a TVar. readTVar :: () => TVar a -> STM a -- | Create a new TVar holding a value supplied newTVar :: () => a -> STM TVar a -- | Swap the contents of a TVar for a new value. swapTVar :: () => TVar a -> a -> STM a -- | Mutate the contents of a TVar. N.B., this version is -- non-strict. modifyTVar :: () => TVar a -> a -> a -> STM () -- | Strict version of modifyTVar. modifyTVar' :: () => TVar a -> a -> a -> STM () -- | A TMVar is a synchronising variable, used for communication -- between concurrent threads. It can be thought of as a box, which may -- be empty or full. data TMVar a -- | Create a TMVar newTMVarIO :: MonadIO m => a -> m (TMVar a) -- | Check whether a given TMVar is empty. isEmptyTMVar :: () => TMVar a -> STM Bool -- | Create a TMVar which is initially empty. newEmptyTMVar :: () => STM TMVar a -- | IO version of newEmptyTMVar. This is useful for -- creating top-level TMVars using unsafePerformIO, because -- using atomically inside unsafePerformIO isn't possible. newEmptyTMVarIO :: () => IO TMVar a -- | This is a combination of takeTMVar and putTMVar; ie. it -- takes the value from the TMVar, puts it back, and also returns -- it. readTMVar :: () => TMVar a -> STM a -- | Return the contents of the TMVar. If the TMVar is -- currently empty, the transaction will retry. After a -- takeTMVar, the TMVar is left empty. takeTMVar :: () => TMVar a -> STM a -- | Put a value into a TMVar. If the TMVar is currently -- full, putTMVar will retry. putTMVar :: () => TMVar a -> a -> STM () -- | Swap the contents of a TMVar for a new value. swapTMVar :: () => TMVar a -> a -> STM a -- | A version of readTMVar which does not retry. Instead it returns -- Nothing if no value is available. tryReadTMVar :: () => TMVar a -> STM Maybe a -- | A version of putTMVar that does not retry. The -- tryPutTMVar function attempts to put the value a into -- the TMVar, returning True if it was successful, or -- False otherwise. tryPutTMVar :: () => TMVar a -> a -> STM Bool -- | A version of takeTMVar that does not retry. The -- tryTakeTMVar function returns Nothing if the -- TMVar was empty, or Just a if the TMVar -- was full with contents a. After tryTakeTMVar, the -- TMVar is left empty. tryTakeTMVar :: () => TMVar a -> STM Maybe a -- | TChan is an abstract type representing an unbounded FIFO -- channel. data TChan a -- | Create a broadcast channel newBroadcastTChanIO :: MonadIO m => m (TChan a) -- | Create a write-only TChan. More precisely, readTChan -- will retry even after items have been written to the channel. -- The only way to read a broadcast channel is to duplicate it with -- dupTChan. -- -- Consider a server that broadcasts messages to clients: -- --
-- serve :: TChan Message -> Client -> IO loop -- serve broadcastChan client = do -- myChan <- dupTChan broadcastChan -- forever $ do -- message <- readTChan myChan -- send client message ---- -- The problem with using newTChan to create the broadcast channel -- is that if it is only written to and never read, items will pile up in -- memory. By using newBroadcastTChan to create the broadcast -- channel, items can be garbage collected after clients have seen them. newBroadcastTChan :: () => STM TChan a -- | Write a value to a TChan. writeTChan :: () => TChan a -> a -> STM () -- | Duplicate a TChan: the duplicate channel begins empty, but data -- written to either channel from then on will be available from both. -- Hence this creates a kind of broadcast channel, where data written by -- anyone is seen by everyone else. dupTChan :: () => TChan a -> STM TChan a -- | Read the next value from the TChan. readTChan :: () => TChan a -> STM a -- | Future values (values that can only be set once) module Haskus.Utils.STM.Future -- | Future value of type a data Future a -- | Setter for a future value data FutureSource a -- | Create a Future and its source newFuture :: STM (Future a, FutureSource a) -- | newFuture in IO newFutureIO :: MonadIO m => m (Future a, FutureSource a) -- | Wait for a future waitFuture :: Future a -> STM a -- | Poll a future pollFuture :: Future a -> STM (Maybe a) -- | pollFuture in IO pollFutureIO :: MonadIO m => Future a -> m (Maybe a) -- | Set a future setFuture :: a -> FutureSource a -> STM () -- | Set a future in IO setFutureIO :: MonadIO m => a -> FutureSource a -> m () -- | Set a future -- -- Return False if it has already been set setFuture' :: a -> FutureSource a -> STM Bool -- | Equality in a STM context module Haskus.Utils.STM.TEq class TEq a teq :: TEq a => a -> a -> STM Bool instance GHC.Classes.Eq a => Haskus.Utils.STM.TEq.TEq (GHC.Conc.Sync.TVar a) -- | Transactional list module Haskus.Utils.STM.TList -- | A double linked-list data TList a -- | A node in the list -- -- Every list has a marker node whose value is Nothing. Its nodePrev -- links to the last node and its nodeNext links to the first node. data TNode a -- | Empty node singleton empty :: STM (TList a) -- | Create a singleton list singleton :: e -> STM (TList e) -- | Indicate if the list is empty null :: TList e -> STM Bool -- | Count the number of elements in the list (0(n)) length :: TList e -> STM Word -- | Get the first element if any first :: TList e -> STM (Maybe (TNode e)) -- | Get the last element if any last :: TList e -> STM (Maybe (TNode e)) -- | Get the previous element if any prev :: TNode a -> STM (Maybe (TNode a)) -- | Get the next element if any next :: TNode a -> STM (Maybe (TNode a)) -- | Get value associated with a node value :: TNode a -> a -- | Remove all the elements of the list (O(1)) deleteAll :: TList a -> STM () -- | Delete a element of the list delete :: TNode a -> STM () -- | Only keep element matching the criterium filter :: (e -> STM Bool) -> TList e -> STM () -- | Find the first node matching the predicate (if any) find :: (e -> STM Bool) -> TList e -> STM (Maybe (TNode e)) -- | Append an element to the list append :: a -> TList a -> STM (TNode a) -- | Append an element to the list append_ :: a -> TList a -> STM () -- | Prepend an element to the list prepend :: a -> TList a -> STM (TNode a) -- | Prepend an element to the list prepend_ :: a -> TList a -> STM () -- | Insert an element before another insertBefore :: a -> TNode a -> STM (TNode a) -- | Insert an element after another insertAfter :: a -> TNode a -> STM (TNode a) -- | Convert into a list (O(n)) toList :: TList a -> STM [a] -- | Convert into a reversed list (O(n)) toReverseList :: TList a -> STM [a] -- | Create from a list fromList :: [e] -> STM (TList e) -- | Get the node from its index index :: Word -> TList e -> STM (Maybe (TNode e)) -- | Take (and remove) up to n elements in the list (O(n)) take :: Word -> TList e -> STM [e] -- | Transactionnal graph module Haskus.Utils.STM.TGraph -- | Deep-first graph traversal -- -- before is executed when the node is entered after is executed when the -- node is leaved children gets node's children deepFirst :: (Monad m, Ord a) => (a -> m ()) -> (a -> m ()) -> (a -> m [a]) -> [a] -> m () -- | Breadth-first graph traversal -- -- visit is executed when the node is entered. If False is returned, the -- traversal ends children gets node's children breadthFirst :: (Monad m, Ord a) => (a -> m Bool) -> (a -> m [a]) -> [a] -> m () -- | A node contains a value and two lists of incoming/outgoing edges data TNode a r TNode :: a -> TList (r, TNode a r) -> TList (r, TNode a r) -> TNode a r [nodeValue] :: TNode a r -> a [nodeEdgeIn] :: TNode a r -> TList (r, TNode a r) [nodeEdgeOut] :: TNode a r -> TList (r, TNode a r) -- | Create a graph node singleton :: a -> STM (TNode a r) -- | Link two nodes together linkTo :: TNode a r -> r -> TNode a r -> STM () -- | STm hashmap module Haskus.Utils.STM.TMap -- | STM hashmap type TMap a b = Map a b -- | A constraint for keys. type Key a = (Eq a, Hashable a) -- | Indicate if the map is empty null :: TMap a b -> STM Bool -- | Get the number of elements in the map size :: TMap a b -> STM Int -- | Lookup an element in the map from its key lookup :: Key k => k -> TMap k a -> STM (Maybe a) -- | Check if a key is in the map member :: Key k => k -> TMap k b -> STM Bool -- | Check if a key is not in the map notMember :: Key k => k -> TMap k b -> STM Bool -- | Create an empty map empty :: STM (TMap a b) -- | Create a map containing a single element singleton :: Key k => k -> v -> STM (TMap k v) -- | Insert an element in the map insert :: Key k => k -> v -> TMap k v -> STM () -- | Create a new TMap from a list fromList :: Key k => [(k, v)] -> STM (TMap k v) -- | Delete an element from the map delete :: Key k => k -> TMap k v -> STM () -- | Get values elems :: TMap a b -> STM [b] -- | Get keys keys :: TMap a b -> STM [a] -- | Unsafe lookup in the map (!) :: Key k => TMap k v -> k -> STM v -- | STM mutable set module Haskus.Utils.STM.TSet -- | STM Set type TSet a = Set a -- | Indicate if the set is empty null :: TSet a -> STM Bool -- | Number of elements in the set size :: TSet a -> STM Int -- | Check if an element is in the set member :: Element e => e -> TSet e -> STM Bool -- | Check if an element is not in the set notMember :: Element e => e -> TSet e -> STM Bool -- | Create an empty set empty :: STM (TSet e) -- | Create a set containing a single element singleton :: Element e => e -> STM (TSet e) -- | Insert an element in a set insert :: Element e => e -> TSet e -> STM () -- | Delete an element from a set delete :: Element e => e -> TSet e -> STM () -- | Convert a set into a list toList :: TSet e -> STM [e] -- | Create a set from a list fromList :: Element e => [e] -> STM (TSet e) -- | Get the set elements elems :: TSet e -> STM [e] -- | Get the set as a ListT stream stream :: TSet e -> ListT STM e -- | Perform a set union unions :: Element e => [TSet e] -> STM (TSet e) -- | Apply a function to each element in the set map :: (Element b) => (a -> b) -> TSet a -> STM (TSet b) -- | STM mutable tree module Haskus.Utils.STM.TTree -- | A STM mutable tree data TTree k v TTree :: k -> v -> TList (TTree k v) -> TVar (Maybe (TTree k v)) -> TTree k v -- | Node identifier [treeKey] :: TTree k v -> k -- | Node value [treeValue] :: TTree k v -> v -- | Children [treeChildren] :: TTree k v -> TList (TTree k v) -- | Parent [treeParent] :: TTree k v -> TVar (Maybe (TTree k v)) -- | Path in the tree newtype TTreePath k TTreePath :: [k] -> TTreePath k -- | Create a singleton node singleton :: k -> v -> STM (TTree k v) -- | Add a child addChild :: k -> v -> TTree k v -> STM (TTree k v) -- | Detach a child detachChild :: TEq k => TTree k v -> STM () -- | Attach a child a node (detaching it from a previous one if necessary) attachChild :: TEq k => TTree k v -> TTree k v -> STM () -- | Follow a path from a parent node treeFollowPath :: TEq k => TTree k v -> TTreePath k -> STM (Maybe (TTree k v)) -- | Simple Constraint solver module Haskus.Utils.Solver -- | Predicate state data PredState -- | Set predicate SetPred :: PredState -- | Unset predicate UnsetPred :: PredState -- | Undefined predicate UndefPred :: PredState -- | Predicate oracle type PredOracle p = Map p PredState -- | Create an oracle from a list makeOracle :: Ord p => [(p, PredState)] -> PredOracle p -- | Get a list of predicates from an oracle oraclePredicates :: Ord p => PredOracle p -> [(p, PredState)] -- | Oracle that always answer Undef emptyOracle :: PredOracle p -- | Ask an oracle if a predicate is set predIsSet :: Ord p => PredOracle p -> p -> Bool -- | Ask an oracle if a predicate is unset predIsUnset :: Ord p => PredOracle p -> p -> Bool -- | Ask an oracle if a predicate is undefined predIsUndef :: Ord p => PredOracle p -> p -> Bool -- | Check the state of a predicate predIs :: Ord p => PredOracle p -> p -> PredState -> Bool -- | Get predicate state predState :: Ord p => PredOracle p -> p -> PredState data Constraint e p Predicate :: p -> Constraint e p Not :: (Constraint e p) -> Constraint e p And :: [Constraint e p] -> Constraint e p Or :: [Constraint e p] -> Constraint e p Xor :: [Constraint e p] -> Constraint e p CBool :: Bool -> Constraint e p -- | Simplify a constraint simplifyConstraint :: Constraint e p -> Constraint e p -- | Reduce a constraint constraintReduce :: (Ord p, Eq p, Eq e) => PredOracle p -> Constraint e p -> Constraint e p data Rule e p a Terminal :: a -> Rule e p a NonTerminal :: [(Constraint e p, Rule e p a)] -> Rule e p a Fail :: e -> Rule e p a -- | NonTerminal whose constraints are evaluated in order -- -- Earlier constraints must be proven false for the next ones to be -- considered orderedNonTerminal :: [(Constraint e p, Rule e p a)] -> Rule e p a -- | Merge two rules together mergeRules :: Rule e p a -> Rule e p b -> Rule e p (a, b) -- | Constraint checking that a predicated value evaluates to some terminal evalsTo :: (Ord (Pred a), Eq a, Eq (PredTerm a), Eq (Pred a), Predicated a) => a -> PredTerm a -> Constraint e (Pred a) -- | Reduction result data MatchResult e nt t NoMatch :: MatchResult e nt t Match :: t -> MatchResult e nt t DontMatch :: nt -> MatchResult e nt t MatchFail :: [e] -> MatchResult e nt t MatchDiverge :: [nt] -> MatchResult e nt t -- | Predicated data -- --
-- data T
-- data NT
--
-- type family RuleT e p a s :: * where
-- RuleT e p a T = a
-- RuleT e p a NT = Rule e p a
--
-- data PD t = PD
-- { p1 :: RuleT () Bool Int t
-- , p2 :: RuleT () Bool String t
-- }
--
-- deriving instance Eq (PD T)
-- deriving instance Show (PD T)
-- deriving instance Ord (PD T)
-- deriving instance Eq (PD NT)
-- deriving instance Show (PD NT)
-- deriving instance Ord (PD NT)
--
--
-- instance Predicated (PD NT) where
-- type PredErr (PD NT) = ()
-- type Pred (PD NT) = Bool
-- type PredTerm (PD NT) = PD T
--
-- liftTerminal (PD a b) = PD (liftTerminal a) (liftTerminal b)
--
-- reducePredicates oracle (PD a b) =
-- initP PD PD
-- |> (applyP reducePredicates oracle a)
-- |> (applyP reducePredicates oracle b)
-- |> resultP
--
-- getTerminals (PD as bs) = [ PD a b | a <- getTerminals as
-- , b <- getTerminals bs
-- ]
--
-- getPredicates (PD a b) = concat
-- [ getPredicates a
-- , getPredicates b
-- ]
--
class Predicated a where {
type family PredErr a :: *;
type family Pred a :: *;
type family PredTerm a :: *;
}
-- | Build a non terminal from a terminal
liftTerminal :: Predicated a => PredTerm a -> a
-- | Reduce predicates
reducePredicates :: Predicated a => PredOracle (Pred a) -> a -> MatchResult (PredErr a) a (PredTerm a)
-- | Get possible resulting terminals
getTerminals :: Predicated a => a -> [PredTerm a]
-- | Get used predicates
getPredicates :: Predicated a => a -> [Pred a]
-- | Create a table of predicates that return a terminal
createPredicateTable :: (Ord (Pred a), Eq (Pred a), Eq a, Predicated a, Predicated a, Pred a ~ Pred a) => a -> (PredOracle (Pred a) -> Bool) -> Bool -> Either (PredTerm a) [(PredOracle (Pred a), PredTerm a)]
-- | Initialise a reduction result (typically with two
-- functions/constructors)
initP :: nt -> t -> MatchResult e nt (nt, t)
-- | Compose reduction results
--
-- We reuse the MatchResult data type: * a "terminal" on the left can be
-- used to build either a terminal or a non terminal * a "non terminal"
-- on the left can only be used to build a non terminal
applyP :: (Predicated ntb) => MatchResult e (ntb -> nt) (ntb -> nt, PredTerm ntb -> t) -> MatchResult e ntb (PredTerm ntb) -> MatchResult e nt (nt, t)
-- | Fixup result (see initP and applyP)
resultP :: MatchResult e nt (nt, t) -> MatchResult e nt t
instance (GHC.Classes.Ord t, GHC.Classes.Ord nt, GHC.Classes.Ord e) => GHC.Classes.Ord (Haskus.Utils.Solver.MatchResult e nt t)
instance (GHC.Classes.Eq t, GHC.Classes.Eq nt, GHC.Classes.Eq e) => GHC.Classes.Eq (Haskus.Utils.Solver.MatchResult e nt t)
instance (GHC.Show.Show t, GHC.Show.Show nt, GHC.Show.Show e) => GHC.Show.Show (Haskus.Utils.Solver.MatchResult e nt t)
instance (GHC.Classes.Ord a, GHC.Classes.Ord p, GHC.Classes.Ord e) => GHC.Classes.Ord (Haskus.Utils.Solver.Rule e p a)
instance (GHC.Classes.Eq a, GHC.Classes.Eq p, GHC.Classes.Eq e) => GHC.Classes.Eq (Haskus.Utils.Solver.Rule e p a)
instance (GHC.Show.Show a, GHC.Show.Show p, GHC.Show.Show e) => GHC.Show.Show (Haskus.Utils.Solver.Rule e p a)
instance GHC.Classes.Ord p => GHC.Classes.Ord (Haskus.Utils.Solver.Constraint e p)
instance GHC.Classes.Eq p => GHC.Classes.Eq (Haskus.Utils.Solver.Constraint e p)
instance GHC.Show.Show p => GHC.Show.Show (Haskus.Utils.Solver.Constraint e p)
instance GHC.Classes.Ord Haskus.Utils.Solver.PredState
instance GHC.Classes.Eq Haskus.Utils.Solver.PredState
instance GHC.Show.Show Haskus.Utils.Solver.PredState
instance (GHC.Classes.Ord p, GHC.Classes.Eq e, GHC.Classes.Eq a, GHC.Classes.Eq p) => Haskus.Utils.Solver.Predicated (Haskus.Utils.Solver.Rule e p a)
instance (GHC.Classes.Ord p, GHC.Classes.Eq e, GHC.Classes.Eq p) => Haskus.Utils.Solver.Predicated (Haskus.Utils.Solver.Constraint e p)
instance GHC.Base.Functor (Haskus.Utils.Solver.MatchResult e nt)
instance GHC.Base.Functor (Haskus.Utils.Solver.Rule e p)
instance GHC.Base.Functor (Haskus.Utils.Solver.Constraint e)