
  0 | module Idrall.Map
  1 | 
  2 | -- helper functions for Map and SortedMap
  3 | 
  4 | import Idrall.Expr
  5 | import Idrall.Error
  6 | import Idrall.Value
  7 | 
  8 | import Data.List
  9 | 
 10 | export
 11 | isOdd : Nat -> Bool
 12 | isOdd Z = False
 13 | isOdd (S k) = not (isOdd k)
 14 | 
 15 | export
 16 | isEven : Nat -> Bool
 17 | isEven k = not $ isOdd k
 18 | 
 19 | export
 20 | mapChunks : (a -> Either e b) -> (k, a) -> Either e (k, b)
 21 | mapChunks f (k, a) = Right (k, !(f a))
 22 | 
 23 | export
 24 | mapListEither : List a -> (a -> Either e b) -> Either e (List b)
 25 | mapListEither [] f = Right []
 26 | mapListEither (x :: xs) f =
 27 |   do rest <- mapListEither xs f
 28 |      x' <- f x
 29 |      Right (x' :: rest)
 30 | 
 31 | export
 32 | mapRecord : (a -> Either e b) -> (k, a) -> Either e (k, b)
 33 | mapRecord f (k, x) = Right (k, !(f x))
 34 | 
 35 | export
 36 | mapUnion : (a -> Either e b) -> (k, Maybe a) -> Either e (k, (Maybe b))
 37 | mapUnion f (k, Just x) =
 38 |   Right (k, Just !(f x))
 39 | mapUnion f (k, Nothing) = Right (k, Nothing)
 40 | 
 41 | export
 42 | mapMaybe : (a -> Either e b) -> Maybe a -> Either e (Maybe b)
 43 | mapMaybe f (Just x) =
 44 |   Right $ Just !(f x)
 45 | mapMaybe f Nothing = Right Nothing
 46 | 
 47 | export
 48 | mergeWithApp : (Monad m, Ord k) =>
 49 |                (a -> a -> m a) ->
 50 |                SortedMap k a ->
 51 |                SortedMap k a ->
 52 |                m (SortedMap k a)
 53 | mergeWithApp f xs ys = sequence (mergeWith (\x,y => (f <$> x <*> y) >>= id) (map pure xs) (map pure ys))
 54 | 
 55 | export
 56 | mergeWithApp' : (Monad m, Ord k) =>
 57 |                (a -> a -> m a) ->
 58 |                SortedMap k a ->
 59 |                SortedMap k a ->
 60 |                m (SortedMap k a)
 61 | mergeWithApp' f xs ys = sequence (mergeWith (\x,y => y) (map pure xs) (map pure ys))
 62 | 
 63 | replace : Eq a => (needle : List a) -> (replacement : List a) -> (haystack : List a) -> List a
 64 | replace needle replacement haystack = go 0 [] needle haystack
 65 |   where
 66 |     go : (pass : Nat) ->
 67 |          (acc : List a) ->
 68 |          (needle : List a) ->
 69 |          (haystack : List a) -> List a
 70 |     go _ acc (x :: xs) [] = acc -- End of list
 71 |     go _ acc [] haystack = haystack -- Empty needle
 72 |     go (S k) acc needle (y :: haystack) = -- Pass through to remove matched elements
 73 |       go k acc needle haystack
 74 |     go Z acc needle@(x :: xs) h@(y :: haystack) =
 75 |       case isPrefixOf needle h of
 76 |            False => go 0 (acc ++ [y]) needle haystack
 77 |            True => go (length xs) (acc ++ replacement) needle haystack
 78 | 
 79 | export
 80 | textReplace : (needle : String) -> (replacement : String) -> (haystack : String) -> String
 81 | textReplace needle replacement haystack = pack $ replace (unpack needle) (unpack replacement) (unpack haystack)
 82 |