module Generics.Putlenses.Examples.Examples where
import Generics.Putlenses.Putlens
import Generics.Putlenses.Language
import Generics.Putlenses.TH
import GHC.Generics
import Data.Char as Char
import Data.Maybe as Maybe
import Data.List as Map
import Data.Map (Map(..))
import qualified Data.Map as Map
import Control.Monad.State (State,MonadState,StateT)
import qualified Control.Monad.State as State
import Control.Monad.Identity
import Control.Monad.Trans
import Control.Monad.Reader
import Control.Exception
import Control.Monad.Writer
import Safe
import Data.List.Split
unzipPut :: (Monad m,Eq a,Eq b) => PutlensM m ([a],[b]) [(a,b)]
unzipPut = (innPut ><< innPut) .< undistsPut .< coassocrPut .< (newPut c -|-< distpPut .< (idPut ><< unzipPut)) .< outPut
where c = Left $ Left ((),())
mapPut :: (Monad m) => PutlensM m b a -> PutlensM m [b] [a]
mapPut f = innPut .< (idPut -|-< f ><< mapPut f) .< outPut
unfoldrPut :: (Monad m,Eq a,Eq b) => PutlensM m (b,a) a -> a -> PutlensM m [b] a
unfoldrPut f x = innPut .< (ignorePut x -|-< (idPut ><< unfoldrPut f x) .< f) .< injPut (\e v -> return $ v==x)
foldrPut :: Monad m => PutlensM m b (Either () (a,b)) -> PutlensM m b [a]
foldrPut f = f .< (idPut -|-< idPut ><< foldrPut f) .< outPut
mfilterPut :: MonadPlus m => (s -> Bool) -> PutlensM m s v -> PutlensM m s v
mfilterPut p f = PutlensM getput' create' where
getput' s = let (v,putf) = getputM f s in (v,mfilter p . putf)
create' v' = mfilter p (createM f v')
unfoldrsPut :: (Monad m,Eq a,Eq b) => PutlensM m (b,a) a -> a -> PutlensM m [b] a
unfoldrsPut f x = innPut .< (ignorePut x -|-< (idPut ><< unfoldrsPut f x) .< f) .< injsOrPut (return . (==x))
nilPut :: (Monad m) => PutlensM m [a] ()
nilPut = innPut .< injlPut
consPut :: (Monad m) => PutlensM m [a] (a,[a])
consPut = innPut .< injrPut
unnilPut :: (Monad m) => PutlensM m () [a]
unnilPut = uninjlPut .< outPut
unconsPut :: (Monad m) => PutlensM m (a,[a]) [a]
unconsPut = uninjrPut .< outPut
unheadPut :: (Monad m,Eq a) => PutlensM m [a] a
unheadPut = consPut .< keepsndPut
untailPut :: (Monad m,Eq a) => PutlensM m [a] [a]
untailPut = consPut .< keepfstPut
wrapPut :: (Monad m,Eq a) => PutlensM m [a] a
wrapPut = consPut .< (idPut ><< nilPut) .< addsndOnePut
unwrapPut :: (Monad m,Eq a) => PutlensM m a [a]
unwrapPut = remsndOnePut .< (idPut ><< unnilPut) .< unconsPut
data Tree a = Empty | Node a (Tree a) (Tree a) deriving Generic
$( makePutlensConstructors ''Tree)
catPut :: (Monad m,Eq a) => PutlensM m ([a],[a]) [a]
catPut = (innPut ><< idPut) .< undistlPut .< (addfstOnePut -|-< assoclPut .< (idPut ><< catPut) .< unconsPut) .< choiceNil
where choiceNil = ifVthenelsePut (null) injlPut injlsPut
exCatPut1 = get (put2lens catPut) ([1,2],[3,4])
exCatPut2 = put (put2lens catPut) ([1,2],[3,4]) [0,1,2,3,4]
exCatPut3 = put (put2lens catPut) ([1,2,3,4],[]) [0,1,2]
exCatPut4 = put (put2lens catPut) ([1,2],[3,4]) [0,1]
catPutN :: (Monad m,Eq a) => (Maybe ([a],[a]) -> [a] -> Int) -> PutlensM m ([a],[a]) [a]
catPutN f = runStatePut (\s v -> return $ f s v) catPutN'
catPutN' :: (Monad m,Eq a) => PutlensStateM m Int ([a],[a]) [a]
catPutN' = (innPut ><< idPut) .< undistlPut .< (addfstOnePut -|-< r) .< (injPut p)
where r = withStatePut (\_ _ st -> return (pred st)) (assoclPut .< (idPut ><< catPutN') .< unconsPut)
p _ _ = do { st <- State.get; return $ st == 0 }
catPut2 :: Eq a => PutlensM Identity ([a],[a]) [a]
catPut2 = catPutN (\s v -> length v `div` 2)
exCatPut21 = get (put2lens catPut2) ([1,2],[3,4])
exCatPut22 = put (put2lens catPut2) ([1,2],[3,4]) [2,1,0,1,2,3,4]
exCatPut23 = put (put2lens catPut2) ([1,2,3,4],[]) [0,1,2]
exCatPut24 = put (put2lens catPut2) ([1,2],[3,4]) [0,1]
catPutP :: (Monad m,Eq a) => (Maybe (Either [a] [a]) -> a -> m Bool) -> PutlensM m ([a],[a]) [a]
catPutP p = (innPut ><< idPut) .< undistlPut .< (addfstOnePut -|-< r) .< (injPut (\s vs -> p s (head vs) >>= \b -> return $ null vs || not b))
where r = (assoclPut .< (idPut ><< catPutP p) .< unconsPut)
catPutSame :: (Monad m,Eq a) => PutlensM m ([a],[a]) [a]
catPutSame = runReaderPutV' $ catPutP (\s v -> ask >>= \v' -> p s v v')
where p s v [] = return False
p s v (x:xs) = return (x==v)
catPutSameMb :: Eq a => PutlensM Identity ([a],[a]) [a]
catPutSameMb = catPutSame
exCatPutSame1 = get (put2lens catPutSameMb) ([1,2],[3,4])
exCatPutSame2 = put (put2lens catPutSameMb) ([1,2],[3,4]) [5,5,5,5,6,7,8]
exCatPutSame3 = put (put2lens catPutSameMb) ([1,2],[3,4]) [0,1,2]
catPutPred :: (Monad m,Ord a) => a -> PutlensM m ([a],[a]) [a]
catPutPred x = catPutP (\i v -> return (v <= x))
catPutPredMb :: Ord a => a -> PutlensM Identity ([a],[a]) [a]
catPutPredMb = catPutPred
exCatPutPred1 = get (put2lens $ catPutPredMb 1) ([1,2],[3,4])
exCatPutPred2 = put (put2lens $ catPutPredMb 1) ([1,2],[3,4]) [2,1,0,1,2,3,4]
exCatPutPred3 = put (put2lens $ catPutPredMb 1) ([1,2,3,4],[]) [0,1,2]
exCatPutPred4 = put (put2lens $ catPutPredMb 1) ([1,2],[3,4]) [0,1]
filterlPut :: (Monad m,Eq a,Eq b) => PutlensM m [Either a b] [a]
filterlPut = innPut .< (idPut -|-< (idPut ><< filterlPut) .< undistlPut) .< coassocrPut .< (outPut -|-< keepfstPut) .< injlsPut
filterrPut :: (Monad m,Eq a,Eq b) => PutlensM m [Either a b] [b]
filterrPut = innPut .< (idPut -|-< (idPut ><< filterrPut) .< undistlPut .< coswapPut) .< coassocrPut .< (outPut -|-< keepfstPut) .< injlsPut
partitionPut :: (Monad m,Eq a,Eq b) => Bool -> PutlensM m [Either a b] ([a],[b])
partitionPut b = innPut .< (idPut -|-< (idPut ><< partitionPut b) .< undistlPut) .< (remfstOnePut -|-< f) .< coassocrPut .< distsPut .< (outPut ><< outPut)
where f = (assocrPut .< (idPut ><< innPut) .< undistrPut -|-< subrPut .< (innPut ><< idPut) .< undistlPut) .< coassoclPut .< (idPut -|-< g) .< cosubrPut
g = cosubrPut .< (idPut -|-< h)
h = if b then injrsPut else injlsPut
filterleftPut :: (Monad m,Eq a,Eq b) => PutlensM m [Either a b] [a]
filterleftPut = partitionPut True .< keepsndOrPut (\l -> return [])
filterPut :: (Monad m,Eq a) => (a -> Bool) -> PutlensM m [a] [a]
filterPut p = mapPut (phiPut p `eitherPutUnsafe` phiPut (not . p)) .< filterleftPut
filterrightPut :: (Monad m,Eq a,Eq b) => PutlensM m [Either a b] [b]
filterrightPut = partitionPut False .< keepfstOrPut (\r -> return [])
succPut :: (Monad m) => PutlensM m Int Int
succPut = customPut (\s -> return . succ) (pred)
predPut :: (Monad m) => PutlensM m Int Int
predPut = customPut (\s -> return . pred) (succ)
data Nat = ZeroN | SuccN Nat deriving (Eq,Show,Generic)
$( makePutlensConstructors ''Nat)
natPut :: (Monad m) => PutlensM m Nat Int
natPut = ifVthenelsePut (==0) (zeroNPut .< ignorePut 0) (succNPut .< natPut .< predPut)
int = get (put2lens natPut)
nat = runIdentity . put (put2lens natPut) ZeroN
lengthNatPut :: (Monad m,Eq a) => (Int -> a) -> PutlensM m [a] Nat
lengthNatPut f = innPut .< (idPut -|-< (idPut ><< lengthNatPut f) .< addfstPut restoreVal) .< outPut
where restoreVal Nothing n = return $ f (int n)
restoreVal (Just (x,_)) _ = return x
exLengthNatPut1 = get (put2lens $ lengthNatPut $ \i -> chr (ord 'A' + i)) "abcd"
exLengthNatPut2 = put (put2lens $ lengthNatPut $ \i -> chr (ord 'A' + i)) "abcd" (nat 10)
exLengthNatPut3 = put (put2lens $ lengthNatPut $ \i -> chr (ord 'A' + i)) "abcd" (nat 2)
embedAtPut :: (Monad m,Eq a) => Int -> PutlensM m [a] a
embedAtPut 0 = unheadPut
embedAtPut n = untailPut .< embedAtPut (n1)
embedAtPut1 :: (Monad m,Eq a) => Int -> PutlensM m [a] a
embedAtPut1 0 = consPut .< keepsndOrPut (\v -> return [])
embedAtPut1 n = consPut .< keepfstOrPut (\v -> return $ head v) .< embedAtPut1 (n1)
embedAtPut2 :: (Monad m,Eq a) => Int -> PutlensM m [a] a
embedAtPut2 i = fixedi .< embedAtPut2'
where fixedi = remfstPut (\x -> ()) .< (ignorePut i ><< idPut)
embedAtPut2' :: (Monad m,Eq a) => PutlensM m (Int,[a]) a
embedAtPut2' = ifSthenelsePut (\(i,l) -> i == 0) stop it
where stop = addfstPut (\m v -> return 0) .< unheadPut
it = (succPut ><< untailPut) .< embedAtPut2'
embedAtPut3 :: (Monad m,Eq a) => Int -> PutlensM m [a] a
embedAtPut3 i = fixedi .< runStatePut (\e v' -> return v') embedAtPut3'
where fixedi = remfstPut (\x -> ()) .< (ignorePut i ><< idPut)
embedAtPut3' :: (Monad m,Eq a) => PutlensStateM m a (Int,[a]) a
embedAtPut3' = ifSthenelsePut (\(i,l) -> i == 0) stop it
where stop = addfstPut (\m v -> return 0) .< unheadPut'
it = (succPut ><< untailPut') .< embedAtPut3'
unheadPut' = consPut .< keepsndOrPut (\v -> return [])
untailPut' = consPut .< keepfstOrPut (\v -> State.get)
exEmbedAtPut1 = get (put2lens $ embedAtPut 2) "abcd"
exEmbedAtPut2 = put (put2lens $ embedAtPut 2) "abcd" 'x'
exEmbedAtPut3 = put (put2lens $ embedAtPut 2) "a" 'x'
exEmbedAtPut4 = get (put2lens $ embedAtPut1 2) "a"
exEmbedAtPut5 = put (put2lens $ embedAtPut1 2) "a" 'x'
embedAtPut4 :: (Monad m,Eq a) => Int -> PutlensM m [a] a
embedAtPut4 i = fixedi .< splitAtPut .< keepfstPut .< unheadPut
where fixedi = remfstPut (\x -> ()) .< (ignorePut i ><< idPut)
splitAtPut :: (Monad m,Eq a) => PutlensM m (Int,[a]) ([a],[a])
splitAtPut = (stop .\/< r) .< distlPut .< (outPut ><< idPut)
where stop = (phiPut (==0) .< newPut 0 ><< idPut)
r = (succPut ><< consPut) .< subrPut .< (idPut ><< splitAtPut) .< assocrPut
exEmbedAtPut41 = get (put2lens $ embedAtPut4 3) "abcde"
exEmbedAtPut42 = put (put2lens $ embedAtPut4 3) "abcde" 'x'
exEmbedAtPut43 = put (put2lens $ embedAtPut4 3) "a" 'x'
splitPut :: (Monad m,Integral a) => ((a,a) -> a -> m a) -> PutlensM m (a,a) a
splitPut offset = customPut put' (uncurry (+))
where put' (Just (x,y)) z = do
off <- offset (x,y) z
let x' = if (x+yz == 0) then 0 else x + off
return (x',z x')
put' Nothing z = return (z,0)
summandsPut1 :: (Monad m,Integral a) => PutlensM m [a] a
summandsPut1 = (unfoldrPut splitBy 0)
where splitBy = splitPut (\e v -> return 0)
summandsPut2 :: (Monad m,Integral a) => PutlensM m [a] a
summandsPut2 = (unfoldrPut splitBy 0)
where splitBy = (splitPut (\(x,y) v' -> return $ div (v' (x+y)) 2))
summandsPut3 :: (Monad m,Integral a) => PutlensM m [a] a
summandsPut3 = runStatePut (\s v -> return $ toEnum (maybe 1 length s)) summandsPut3'
summandsPut3' :: (Monad m,Integral a) => PutlensStateM m a [a] a
summandsPut3' = unfoldrPut (updateStatePut (\s v st -> return $ pred st) splitBy) 0
where splitBy = splitPut (\(x,y) v' -> State.get >>= return . div (v' (x+y)))
summandsPut4 :: (Monad m,Integral a) => PutlensM m [a] a
summandsPut4 = runStatePut (\s v -> return $ toEnum (maybe 1 length s)) summandsPut4'
summandsPut4' :: (Monad m,Integral a) => PutlensStateM m a [a] a
summandsPut4' = unfoldrsPut (updateStatePut (\s v st -> return $ pred st) splitBy) 0
where splitBy = (splitPut (\(x,y) v' -> do {st <- State.get; return $ div (v' (x+y)) st }))
exSummandsPut1 = get (put2lens summandsPut1) [1,2,3,4]
exSummandsPut2 = runIdentity $ put (put2lens summandsPut1) [1,2,3,4] 15
exSummandsPut3 = runIdentity $ put (put2lens summandsPut2) [1,2,3,4] 15
exSummandsPut4 = runIdentity $ put (put2lens summandsPut3) [1,2,3,4] 15
exSummandsPut5 = runIdentity $ put (put2lens summandsPut3) [1,2,3,4] 0
exSummandsPut6 = runIdentity $ put (put2lens summandsPut4) [1,2,3,4] 15
exSummandsPut7 = runIdentity $ put (put2lens summandsPut4) [1,2,3,4] 0
replicatePut :: (Monad m,Eq a) => PutlensM m (a,Int) [a]
replicatePut = (zero .\/< (one .\/< r) .< distrPut .< (idPut ><< outPut)) .< outPut
where zero = keepfstPut .< phiPut (==0) .< newPut 0
one = idPut ><< phiPut (==1) .< newPut 1
r = (idPut ><< succPut) .< remfstPut (fst) .< (idPut ><< replicatePut .< consPut)
exReplicatePut1 = put (put2lens replicatePut) ('b',2) "aaaa"
exReplicatePut2 = put (put2lens replicatePut) ('b',2) ""
replicateListPut :: (Monad m,Eq a) => PutlensM m [(a,Int)] [a]
replicateListPut = recoverzerosPut .< mapPut replicatePut .< splitListPut
recoverzerosPut :: (Monad m,Eq a) => PutlensM m [(a,Int)] [(a,Int)]
recoverzerosPut = ifthenelsePut (\s v -> return $ p s) zero r
where p (Just ((a,0):xs)) = True
p _ = False
zero = phiPut (p . Just) .< consPut .< (idPut ><< recoverzerosPut) .< addfstPut (\(Just (x,xs)) v -> return x)
r = innPut .< (idPut -|-< idPut ><< recoverzerosPut) .< outPut
splitListPut :: (Monad m,Eq a) => PutlensM m [[a]] [a]
splitListPut = innPut .< (idPut -|-< ifVthenelsePut ( p) eq neq .< (idPut ><< splitListPut)) .< outPut
where p (x,(x':xs):xss) = x == x'
p (x,xss) = False
eq = (consPut ><< idPut) .< assoclPut .< (idPut ><< unconsPut)
neq = wrapPut ><< idPut
exReplicateListPut1 = get (put2lens replicateListPut) [('a',4),('b',0),('c',3)]
exReplicateListPut2 = put (put2lens replicateListPut) [('a',4),('b',0),('c',3)] "xxyyz"
halvePut :: (Monad m,Eq a) => a -> PutlensM m [a] [a]
halvePut x = remfstPut ( half) .< splitAtPut .< addsndPut right
where half xs = let d = length xs
in if even d then d `div` 2 else (d `div` 2)+1
right (Just (l,r)) v = let s = take (length v) r
in return $ s ++ replicate (length v length s 1) x
halvePutMb :: Eq a => a -> PutlensM Identity [a] [a]
halvePutMb = halvePut
exHalvePut1 = put (put2lens $ halvePutMb ' ') "abcde" "xy"
exHalvePut2 = put (put2lens $ halvePutMb '0') "xyz" "abcde"
halvePut2 :: (Monad m,Eq a) => a -> PutlensM m [a] [a]
halvePut2 x = remsndPut (const 0) .< halvePut2' x .< addsndPut (\e -> return . length)
halvePut2' :: (Monad m,Eq a) => a -> PutlensM m ([a],Int) ([a],Int)
halvePut2' x = (phiPut (ifcond) .< empty .\/< r) .< distlPut .< (outPut ><< idPut)
where ifcond (xs,k) = k >= length xs
empty = addfstPut appendRight .< remfstOnePut
appendRight (Just (rs,_)) k = return $ if k >= length rs then take (pred k) (rs++repeat x) else take k rs
appendRight Nothing k = return $ take (pred k) (repeat x)
r = (consPut ><< predPut) .< assoclPut .< (idPut ><< halvePut2' x) .< assocrPut
exHalvePut21 = put (put2lens $ halvePut2 ' ') "abcde" "xy"
exHalvePut22 = put (put2lens $ halvePut2 '0') "xyz" "abcde"
exHalvePut23 = put (put2lens $ halvePut2 ' ') "abc" "xy"
halvePut3 :: (Monad m,Eq a) => a -> PutlensM m [a] [a]
halvePut3 x = runStatePut (\_ _ -> return 0) $ remsndPut (length) .< halvePut3' x
halvePut3' :: (Monad m,Eq a) => a -> PutlensStateM m Int ([a],Int) [a]
halvePut3' x = ifVthenelsePut (null) (nil .< unnilPut) (cons .< unconsPut)
where nil = phiPut (\(xs,k) -> k <= 0) .< pntPut appendRight
appendRight (Just (rs,_)) = do
k <- State.get
return $ if k >= length rs then (take (pred k) (rs++repeat x),1) else (take k rs,0)
appendRight Nothing = do
k <- State.get
return $ (take (pred k) (repeat x),1)
cons = (consPut ><< succPut .< succPut) .< assoclPut .< (withStatePut (\_ _ i -> return $ succ i) idPut ><< halvePut3' x)
exHalvePut31 = put (put2lens $ halvePut3 ' ') "abcde" "xy"
exHalvePut32 = put (put2lens $ halvePut3 '0') "xyz" "abcde"
exHalvePut33 = put (put2lens $ halvePut3 ' ') "abc" "xy"
isumPut :: (Monad m) => PutlensM m [Int] [Int]
isumPut = innPut .< (idPut -|-< (idPut ><< isumPut) .< paramfstPut dec) .< outPut
where dec i = mapPut (subtractPut i)
subtractPut :: (Monad m) => Int -> PutlensM m Int Int
subtractPut i = customPut (\s x -> return $ xi) (+i)
exIsumPut1 = get (put2lens isumPut) [1,2,3,4]
exIsumPut2 = put (put2lens isumPut) [1,2,3,4] [3,4]
iunsortPut1 :: (Monad m,Ord a) => PutlensM m [a] [a]
iunsortPut1 = ifVthenelsePut (null) (nilPut .< unnilPut) it
where it = consPut .< (idPut ><< iunsortPut1) .< delPut1
delPut1 :: (Monad m,Ord a) => PutlensM m (a,[a]) [a]
delPut1 = ifVthenelsePut (null . snd) idPut disarrange .< unconsPut
where disarrange = ifSthenelsePut (p) idPut it
p (x,[]) = True
p (x,ys) = x <= head ys
it = (idPut ><< consPut) .< subrPut .< (idPut ><< delPut1)
iunsortPut2 :: (Monad m,Ord a) => PutlensM m [a] [a]
iunsortPut2 = ifVthenelsePut (null) (nilPut .< unnilPut) swap
where swap = consPut .< (idPut ><< iunsortPut2) .< delPut2
delPut2 :: (Monad m,Ord a) => PutlensM m (a,[a]) [a]
delPut2 = ifVthenelsePut (null . snd) idPut disarrange .< unconsPut
where disarrange = ifthenelsePut (test) (phiPut p) swap
p (x,[]) = True
p (x,ys) = x <= head ys
swap = (idPut ><< consPut) .< subrPut .< (idPut ><< delPut2)
test (Just v) v' = if p v && v == v' then return False else return True
test _ v' = return True
exIunsortPut1 = runIdentity $ put (put2lens iunsortPut1) [4,1,3,2] [5,6,7,8,9,10]
exIunsortPut2 = runIdentity $ put (put2lens iunsortPut2) [4,1,3,2] [5,6,7,8,9,10]
exIunsortPut3 = runIdentity $ put (put2lens iunsortPut2) [4,1,3,2] [1,2,3,4]
qsortPut :: (Monad m,Ord a) => PutlensM m [a] [a]
qsortPut = innPut .< (unnilPut -|-< qpartitionPut .< (idPut ><< (qsortPut ><< qsortPut)) .< subrPut .< (idPut ><< unconsPut) .< catPutNonEmptyRight) .< (injPut (\e -> return . null))
qpartitionPut :: (Monad m,Ord a) => PutlensM m (a,[a]) (a,([a],[a]))
qpartitionPut = customPut (\s (y,(xs,ys)) -> return $ (y,xs++ys)) (\(x,xs) -> (x,partition (<x) xs))
catPutNonEmptyRight :: (Monad m,Eq a) => PutlensM m ([a],[a]) [a]
catPutNonEmptyRight = catPutN f
where f Nothing v = 0
f (Just (xs,y)) v = if length xs > length v then 0 else length xs
exQsortPut1 = get (put2lens qsortPut) [4,3,1,2]
exQsortPut2 = runIdentity $ put (put2lens qsortPut) [4,1,3,2] [4,3,2,1,0,7]
exQsortPut3 = runIdentity $ put (put2lens qsortPut) [4,1,3,2] [5,6,7,8,9,10]
positionsPut :: (Monad m,Eq a) => PutlensM m [a] [(Int,a)]
positionsPut = positionsPut' 0
positionsPut' :: (Monad m,Eq a) => Int -> PutlensM m [a] [(Int,a)]
positionsPut' i = innPut .< (idPut -|-< remfstPut (const i) ><< positionsPut' (succ i)) .< outPut
positionsPut2 :: (Monad m,Eq a) => PutlensM m [a] [(Int,a)]
positionsPut2 = remfstPut (const 0) .< runReaderPutV' positionsPut2'
positionsPut2' :: (Monad m,Eq a) => PutlensReaderM m [(Int,a)] (Int,[a]) [(Int,a)]
positionsPut2' = (idPut ><< innPut) .< undistrPut .< (empty -|-< it) .< outPut
where empty = addfstPut (\s v -> ask >>= \m -> return $ length m)
it = (remsndPut (succ) ><< idPut) .< distpPut .< (idPut ><< positionsPut2')
exIntitions1 = get (put2lens positionsPut) "abcd"
exIntitions2 = runIdentity $ put (put2lens positionsPut) "abcd" [(0,'x'),(1,'y')]
exIntitions3 = runIdentity $ put (put2lens positionsPut) "abcd" [(0,'x'),(1,'y'),(2,'a'),(3,'b'),(4,'c'),(5,'d')]
appendWithSepPut :: (Monad m) => String -> PutlensM m (String,String) String
appendWithSepPut sep = customPut put (\(s1,s2) -> s1++sep++s2)
where put s v = case splitOn sep v of
(x:y:xs) -> return (x,y ++ concat (map (sep++) xs))
otherwise -> fail "qwe"
readPut :: (MonadPlus m,Read a,Show a) => PutlensM m a String
readPut = PutlensM getputM createM
where createM v = case readMay v of { Just s -> return s; Nothing -> fail "failed to cast string" }
getputM s = (return $ show s,createM)
unwordsIntBool :: PutlensM Maybe [Either Int Bool] String
unwordsIntBool = mapPut (injunionPut readPut readPut) .< unwordsPut
unwordsPut :: PutlensM Maybe [String] String
unwordsPut = unionPut (nilPut .< ignorePut "") (unfoldr1Put (appendWithSepPut " "))
unfoldr1Put :: (MonadPlus m,Eq a) => PutlensM m (a,a) a -> PutlensM m [a] a
unfoldr1Put f = unionPut wrapPut (consPut .< (idPut ><< unfoldr1Put f) .< f)