Skip to content

Commit

Permalink
Add unfoldrM and repeatedlyM
Browse files Browse the repository at this point in the history
  • Loading branch information
kamil-adam committed Sep 17, 2022
1 parent 7a253f4 commit dd6e5fa
Show file tree
Hide file tree
Showing 71 changed files with 266 additions and 209 deletions.
5 changes: 5 additions & 0 deletions docs/developers/CHANGELOG.md
Original file line number Diff line number Diff line change
@@ -1,5 +1,10 @@
# 📅 Revision history for HelVM Common

## 0.1.1.2 -- 2022-09-17

* Add `unfoldrM`
* Add `repeatedlyM`

## 0.1.1.1 -- 2022-09-12

* Add `fromJustWithText`
Expand Down

This file was deleted.

Original file line number Diff line number Diff line change
Expand Up @@ -55,7 +55,7 @@
<span class="lineno"> 36 </span>
<span class="lineno"> 37 </span>-- | Internal function
<span class="lineno"> 38 </span>listFromDescList :: Default a =&gt; IndexedList a -&gt; [a]
<span class="lineno"> 39 </span><span class="decl"><span class="istickedoff">listFromDescList = loop act . ( [] , ) where</span>
<span class="lineno"> 39 </span><span class="decl"><span class="istickedoff">listFromDescList = loop act . ([] , ) where</span>
<span class="lineno"> 40 </span><span class="spaces"> </span><span class="istickedoff">act :: Default a =&gt; AccWithIndexedList a -&gt; Either (AccWithIndexedList a) [a]</span>
<span class="lineno"> 41 </span><span class="spaces"> </span><span class="istickedoff">act (acc , [] ) = <span class="nottickedoff">Right acc</span></span>
<span class="lineno"> 42 </span><span class="spaces"> </span><span class="istickedoff">act (acc , [(i , v)] ) = Right $ consDef i $ v : acc</span>
Expand Down
Original file line number Diff line number Diff line change
@@ -0,0 +1,113 @@
<html>
<head>
<meta http-equiv="Content-Type" content="text/html; charset=UTF-8">
<style type="text/css">
span.lineno { color: white; background: #aaaaaa; border-right: solid white 12px }
span.nottickedoff { background: yellow}
span.istickedoff { background: white }
span.tickonlyfalse { margin: -1px; border: 1px solid #f20913; background: #f20913 }
span.tickonlytrue { margin: -1px; border: 1px solid #60de51; background: #60de51 }
span.funcount { font-size: small; color: orange; z-index: 2; position: absolute; right: 20 }
span.decl { font-weight: bold }
span.spaces { background: white }
</style>
</head>
<body>
<pre>
<span class="decl"><span class="nottickedoff">never executed</span> <span class="tickonlytrue">always true</span> <span class="tickonlyfalse">always false</span></span>
</pre>
<pre>
<span class="lineno"> 1 </span>module HelVM.HelIO.Extra (
<span class="lineno"> 2 </span> toUppers,
<span class="lineno"> 3 </span> splitOneOf,
<span class="lineno"> 4 </span> showP,
<span class="lineno"> 5 </span> showToText,
<span class="lineno"> 6 </span> genericChr,
<span class="lineno"> 7 </span> (???),
<span class="lineno"> 8 </span> fromMaybeOrDef,
<span class="lineno"> 9 </span> headMaybe,
<span class="lineno"> 10 </span> fromJustWith,
<span class="lineno"> 11 </span> fromJustWithText,
<span class="lineno"> 12 </span> unfoldrM,
<span class="lineno"> 13 </span>-- unfoldr,
<span class="lineno"> 14 </span> repeatedlyM,
<span class="lineno"> 15 </span> repeatedly,
<span class="lineno"> 16 </span> tee,
<span class="lineno"> 17 </span>) where
<span class="lineno"> 18 </span>
<span class="lineno"> 19 </span>import Data.Char hiding (chr)
<span class="lineno"> 20 </span>import Data.Default
<span class="lineno"> 21 </span>import Data.Typeable
<span class="lineno"> 22 </span>import Text.Pretty.Simple
<span class="lineno"> 23 </span>
<span class="lineno"> 24 </span>import qualified Data.Text as Text
<span class="lineno"> 25 </span>
<span class="lineno"> 26 </span>-- | TextExtra
<span class="lineno"> 27 </span>
<span class="lineno"> 28 </span>toUppers :: Text -&gt; Text
<span class="lineno"> 29 </span><span class="decl"><span class="nottickedoff">toUppers = Text.map toUpper</span></span>
<span class="lineno"> 30 </span>
<span class="lineno"> 31 </span>splitOneOf :: String -&gt; Text -&gt; [Text]
<span class="lineno"> 32 </span><span class="decl"><span class="nottickedoff">splitOneOf s = Text.split contains where contains c = c `elem` s</span></span>
<span class="lineno"> 33 </span>
<span class="lineno"> 34 </span>-- | ShowExtra
<span class="lineno"> 35 </span>
<span class="lineno"> 36 </span>showP :: Show a =&gt; a -&gt; Text
<span class="lineno"> 37 </span><span class="decl"><span class="nottickedoff">showP = toText . pShowNoColor</span></span>
<span class="lineno"> 38 </span>
<span class="lineno"> 39 </span>showToText :: (Typeable a , Show a) =&gt; a -&gt; Text
<span class="lineno"> 40 </span><span class="decl"><span class="nottickedoff">showToText a = show a `fromMaybe` (cast a :: Maybe Text)</span></span>
<span class="lineno"> 41 </span>
<span class="lineno"> 42 </span>-- | CharExtra
<span class="lineno"> 43 </span>
<span class="lineno"> 44 </span>genericChr :: Integral a =&gt; a -&gt; Char
<span class="lineno"> 45 </span><span class="decl"><span class="nottickedoff">genericChr = chr . fromIntegral</span></span>
<span class="lineno"> 46 </span>
<span class="lineno"> 47 </span>-- | MaybeExtra
<span class="lineno"> 48 </span>
<span class="lineno"> 49 </span>infixr 0 ???
<span class="lineno"> 50 </span>(???) :: Maybe a -&gt; a -&gt; a
<span class="lineno"> 51 </span><span class="decl"><span class="nottickedoff">(???) = flip fromMaybe</span></span>
<span class="lineno"> 52 </span>
<span class="lineno"> 53 </span>fromMaybeOrDef :: Default a =&gt; Maybe a -&gt; a
<span class="lineno"> 54 </span><span class="decl"><span class="nottickedoff">fromMaybeOrDef = fromMaybe def</span></span>
<span class="lineno"> 55 </span>
<span class="lineno"> 56 </span>headMaybe :: [a] -&gt; Maybe a
<span class="lineno"> 57 </span><span class="decl"><span class="nottickedoff">headMaybe = viaNonEmpty head</span></span>
<span class="lineno"> 58 </span>
<span class="lineno"> 59 </span>fromJustWith :: Show e =&gt; e -&gt; Maybe a -&gt; a
<span class="lineno"> 60 </span><span class="decl"><span class="nottickedoff">fromJustWith e = fromJustWithText (show e)</span></span>
<span class="lineno"> 61 </span>
<span class="lineno"> 62 </span>fromJustWithText :: Text -&gt; Maybe a -&gt; a
<span class="lineno"> 63 </span><span class="decl"><span class="nottickedoff">fromJustWithText t Nothing = error t</span>
<span class="lineno"> 64 </span><span class="spaces"></span><span class="nottickedoff">fromJustWithText _ (Just a) = a</span></span>
<span class="lineno"> 65 </span>
<span class="lineno"> 66 </span>-- | ListExtra
<span class="lineno"> 67 </span>
<span class="lineno"> 68 </span>unfoldrM :: Monad m =&gt; (a -&gt; m (Maybe (b, a))) -&gt; a -&gt; m [b]
<span class="lineno"> 69 </span><span class="decl"><span class="nottickedoff">unfoldrM f a = go =&lt;&lt; f a where</span>
<span class="lineno"> 70 </span><span class="spaces"> </span><span class="nottickedoff">go Nothing = pure []</span>
<span class="lineno"> 71 </span><span class="spaces"> </span><span class="nottickedoff">go (Just (b, a')) = (b : ) &lt;$&gt; (go =&lt;&lt; f a')</span></span>
<span class="lineno"> 72 </span>
<span class="lineno"> 73 </span>--unfoldr :: (a -&gt; Maybe (b, a)) -&gt; a -&gt; [b]
<span class="lineno"> 74 </span>--unfoldr f = runIdentity . unfoldrM (Identity . f)
<span class="lineno"> 75 </span>
<span class="lineno"> 76 </span>repeatedlyM :: Monad m =&gt; ([a] -&gt; m (b, [a])) -&gt; [a] -&gt; m [b]
<span class="lineno"> 77 </span><span class="decl"><span class="nottickedoff">repeatedlyM f = go where</span>
<span class="lineno"> 78 </span><span class="spaces"> </span><span class="nottickedoff">go [] = pure []</span>
<span class="lineno"> 79 </span><span class="spaces"> </span><span class="nottickedoff">go a = build =&lt;&lt; f a where build (b, a') = (b : ) &lt;$&gt; go a'</span></span>
<span class="lineno"> 80 </span>
<span class="lineno"> 81 </span>repeatedly :: ([a] -&gt; (b, [a])) -&gt; [a] -&gt; [b]
<span class="lineno"> 82 </span><span class="decl"><span class="nottickedoff">repeatedly f = runIdentity . repeatedlyM (Identity . f)</span></span>
<span class="lineno"> 83 </span>
<span class="lineno"> 84 </span>-- | Extra
<span class="lineno"> 85 </span>
<span class="lineno"> 86 </span>tee :: (a -&gt; b -&gt; c) -&gt; (a -&gt; b) -&gt; a -&gt; c
<span class="lineno"> 87 </span><span class="decl"><span class="nottickedoff">tee f1 f2 a = f1 a $ f2 a</span></span>
<span class="lineno"> 88 </span>
<span class="lineno"> 89 </span>--type Act s a = s -&gt; Either s a
<span class="lineno"> 90 </span>--type ActM m s a = s -&gt; m (Either s a)

</pre>
</body>
</html>
Loading

0 comments on commit dd6e5fa

Please sign in to comment.