-- |
-- Bidirectional version of "Data.List" and other operations over lists.
{-# LANGUAGE Safe, QuasiQuotes, TypeOperators #-}
module Data.Invertible.List
  ( cons
  , uncons
  , consMaybe
  , repLen
  , map
  , reverse
  , transpose
  , lookup
  , index
  , zip
  , zip3
  , zip4
  , zip5
  , zip6
  , zip7
  , zipWith
  , interleave
  , lines
  , words
  ) where

import Prelude hiding (map, reverse, lookup, zip, zip3, unzip, zipWith, lines, words)
import Control.Arrow ((***))
import qualified Data.List as L
import Data.Tuple (swap)

import Data.Invertible.Bijection
import Data.Invertible.TH
import Data.Invertible.Internal

-- |Convert between @'Just' (head, tail)@ and the non-empty list @head:tail@.
cons :: Maybe (a, [a]) <-> [a]
cons :: forall a. Maybe (a, [a]) <-> [a]
cons =
  [biCase|
    Just (a, l) <-> a:l
    Nothing <-> []
  |]

-- |Convert between the non-empty list @head:tail@ and @'Just' (head, tail)@. (@'Control.Invertible.BiArrow.invert' 'cons'@)
uncons :: [a] <-> Maybe (a, [a])
uncons :: forall a. [a] <-> Maybe (a, [a])
uncons = Bijection (->) (Maybe (a, [a])) [a]
-> Bijection (->) [a] (Maybe (a, [a]))
forall (a :: * -> * -> *) b c. Bijection a b c -> Bijection a c b
invert Bijection (->) (Maybe (a, [a])) [a]
forall a. Maybe (a, [a]) <-> [a]
cons

-- |Convert between @('Just' head, tail)@ and the non-empty list @head:tail@, or @('Nothing', list)@ and @list@.
consMaybe :: (Maybe a, [a]) <-> [a]
consMaybe :: forall a. (Maybe a, [a]) <-> [a]
consMaybe =
  [biCase|
    (Just a, l) <-> a:l
    (Nothing, l) <-> l
  |]

-- |Combine 'L.replicate' and 'L.length' for unit lists.
repLen :: Int <-> [()]
repLen :: Int <-> [()]
repLen = (Int -> () -> [()]
forall a. Int -> a -> [a]
`L.replicate` ()) (Int -> [()]) -> ([()] -> Int) -> Int <-> [()]
forall (a :: * -> * -> *) b c. a b c -> a c b -> Bijection a b c
:<->: [()] -> Int
forall a. [a] -> Int
forall (t :: * -> *) a. Foldable t => t a -> Int
L.length

-- |Apply a bijection over a list using 'L.map'.
map :: (a <-> b) -> [a] <-> [b]
map :: forall a b. (a <-> b) -> [a] <-> [b]
map (a -> b
f :<->: b -> a
g) = (a -> b) -> [a] -> [b]
forall a b. (a -> b) -> [a] -> [b]
L.map a -> b
f ([a] -> [b]) -> ([b] -> [a]) -> Bijection (->) [a] [b]
forall (a :: * -> * -> *) b c. a b c -> a c b -> Bijection a b c
:<->: (b -> a) -> [b] -> [a]
forall a b. (a -> b) -> [a] -> [b]
L.map b -> a
g

-- |'L.reverse' the order of a (finite) list.
reverse :: [a] <-> [a]
reverse :: forall a. [a] <-> [a]
reverse = ([a] -> [a]) -> Bijection (->) [a] [a]
forall (a :: * -> * -> *) b. a b b -> Bijection a b b
involution [a] -> [a]
forall a. [a] -> [a]
L.reverse

-- |'L.transpose' the rows and columns of its argument.
transpose :: [[a]] <-> [[a]]
transpose :: forall a. [[a]] <-> [[a]]
transpose = ([[a]] -> [[a]]) -> Bijection (->) [[a]] [[a]]
forall (a :: * -> * -> *) b. a b b -> Bijection a b b
involution [[a]] -> [[a]]
forall a. [[a]] -> [[a]]
L.transpose

-- |Bi-directional 'L.lookup'.
lookup :: (Eq a, Eq b) => [(a, b)] -> Maybe a <-> Maybe b
lookup :: forall a b. (Eq a, Eq b) => [(a, b)] -> Maybe a <-> Maybe b
lookup [(a, b)]
l = ((a -> [(a, b)] -> Maybe b) -> [(a, b)] -> a -> Maybe b
forall a b c. (a -> b -> c) -> b -> a -> c
flip a -> [(a, b)] -> Maybe b
forall a b. Eq a => a -> [(a, b)] -> Maybe b
L.lookup [(a, b)]
l (a -> Maybe b) -> Maybe a -> Maybe b
forall (m :: * -> *) a b. Monad m => (a -> m b) -> m a -> m b
=<<) (Maybe a -> Maybe b)
-> (Maybe b -> Maybe a) -> Bijection (->) (Maybe a) (Maybe b)
forall (a :: * -> * -> *) b c. a b c -> a c b -> Bijection a b c
:<->: ((b -> [(b, a)] -> Maybe a) -> [(b, a)] -> b -> Maybe a
forall a b c. (a -> b -> c) -> b -> a -> c
flip b -> [(b, a)] -> Maybe a
forall a b. Eq a => a -> [(a, b)] -> Maybe b
L.lookup (((a, b) -> (b, a)) -> [(a, b)] -> [(b, a)]
forall a b. (a -> b) -> [a] -> [b]
L.map (a, b) -> (b, a)
forall a b. (a, b) -> (b, a)
swap [(a, b)]
l) (b -> Maybe a) -> Maybe b -> Maybe a
forall (m :: * -> *) a b. Monad m => (a -> m b) -> m a -> m b
=<<)

-- |Combine 'L.elemIndex' and safe 'L.!!'.
index :: Eq a => [a] -> Maybe a <-> Maybe Int
index :: forall a. Eq a => [a] -> Maybe a <-> Maybe Int
index [a]
l = ((a -> [a] -> Maybe Int) -> [a] -> a -> Maybe Int
forall a b c. (a -> b -> c) -> b -> a -> c
flip a -> [a] -> Maybe Int
forall a. Eq a => a -> [a] -> Maybe Int
L.elemIndex [a]
l (a -> Maybe Int) -> Maybe a -> Maybe Int
forall (m :: * -> *) a b. Monad m => (a -> m b) -> m a -> m b
=<<) (Maybe a -> Maybe Int)
-> (Maybe Int -> Maybe a) -> Bijection (->) (Maybe a) (Maybe Int)
forall (a :: * -> * -> *) b c. a b c -> a c b -> Bijection a b c
:<->: ([a] -> Int -> Maybe a
forall {a} {a}. (Ord a, Num a, Enum a) => [a] -> a -> Maybe a
idx [a]
l (Int -> Maybe a) -> Maybe Int -> Maybe a
forall (m :: * -> *) a b. Monad m => (a -> m b) -> m a -> m b
=<<) where
  idx :: [a] -> a -> Maybe a
idx [a]
_ a
i | a
i a -> a -> Bool
forall a. Ord a => a -> a -> Bool
< a
0 = Maybe a
forall a. Maybe a
Nothing
  idx [] a
_ = Maybe a
forall a. Maybe a
Nothing
  idx (a
x:[a]
_) a
0 = a -> Maybe a
forall a. a -> Maybe a
Just a
x
  idx (a
_:[a]
r) a
i = [a] -> a -> Maybe a
idx [a]
r (a -> Maybe a) -> a -> Maybe a
forall a b. (a -> b) -> a -> b
$ a -> a
forall a. Enum a => a -> a
pred a
i

-- |'L.zip' two lists together.
zip :: ([a], [b]) <-> [(a, b)]
zip :: forall a b. ([a], [b]) <-> [(a, b)]
zip = ([a] -> [b] -> [(a, b)]) -> ([a], [b]) -> [(a, b)]
forall a b c. (a -> b -> c) -> (a, b) -> c
uncurry [a] -> [b] -> [(a, b)]
forall a b. [a] -> [b] -> [(a, b)]
L.zip (([a], [b]) -> [(a, b)])
-> ([(a, b)] -> ([a], [b])) -> Bijection (->) ([a], [b]) [(a, b)]
forall (a :: * -> * -> *) b c. a b c -> a c b -> Bijection a b c
:<->: [(a, b)] -> ([a], [b])
forall a b. [(a, b)] -> ([a], [b])
L.unzip

-- |'L.zip3' three lists together.
zip3 :: ([a], [b], [c]) <-> [(a, b, c)]
zip3 :: forall a b c. ([a], [b], [c]) <-> [(a, b, c)]
zip3 = (\([a]
a,[b]
b,[c]
c) -> [a] -> [b] -> [c] -> [(a, b, c)]
forall a b c. [a] -> [b] -> [c] -> [(a, b, c)]
L.zip3 [a]
a [b]
b [c]
c) (([a], [b], [c]) -> [(a, b, c)])
-> ([(a, b, c)] -> ([a], [b], [c]))
-> Bijection (->) ([a], [b], [c]) [(a, b, c)]
forall (a :: * -> * -> *) b c. a b c -> a c b -> Bijection a b c
:<->: [(a, b, c)] -> ([a], [b], [c])
forall a b c. [(a, b, c)] -> ([a], [b], [c])
L.unzip3

-- |'L.zip4' four lists together.
zip4 :: ([a], [b], [c], [d]) <-> [(a, b, c, d)]
zip4 :: forall a b c d. ([a], [b], [c], [d]) <-> [(a, b, c, d)]
zip4 = (\([a]
a,[b]
b,[c]
c,[d]
d) -> [a] -> [b] -> [c] -> [d] -> [(a, b, c, d)]
forall a b c d. [a] -> [b] -> [c] -> [d] -> [(a, b, c, d)]
L.zip4 [a]
a [b]
b [c]
c [d]
d) (([a], [b], [c], [d]) -> [(a, b, c, d)])
-> ([(a, b, c, d)] -> ([a], [b], [c], [d]))
-> Bijection (->) ([a], [b], [c], [d]) [(a, b, c, d)]
forall (a :: * -> * -> *) b c. a b c -> a c b -> Bijection a b c
:<->: [(a, b, c, d)] -> ([a], [b], [c], [d])
forall a b c d. [(a, b, c, d)] -> ([a], [b], [c], [d])
L.unzip4

-- |'L.zip5' five lists together.
zip5 :: ([a], [b], [c], [d], [e]) <-> [(a, b, c, d, e)]
zip5 :: forall a b c d e. ([a], [b], [c], [d], [e]) <-> [(a, b, c, d, e)]
zip5 = (\([a]
a,[b]
b,[c]
c,[d]
d,[e]
e) -> [a] -> [b] -> [c] -> [d] -> [e] -> [(a, b, c, d, e)]
forall a b c d e.
[a] -> [b] -> [c] -> [d] -> [e] -> [(a, b, c, d, e)]
L.zip5 [a]
a [b]
b [c]
c [d]
d [e]
e) (([a], [b], [c], [d], [e]) -> [(a, b, c, d, e)])
-> ([(a, b, c, d, e)] -> ([a], [b], [c], [d], [e]))
-> Bijection (->) ([a], [b], [c], [d], [e]) [(a, b, c, d, e)]
forall (a :: * -> * -> *) b c. a b c -> a c b -> Bijection a b c
:<->: [(a, b, c, d, e)] -> ([a], [b], [c], [d], [e])
forall a b c d e. [(a, b, c, d, e)] -> ([a], [b], [c], [d], [e])
L.unzip5

-- |'L.zip6' six lists together.
zip6 :: ([a], [b], [c], [d], [e], [f]) <-> [(a, b, c, d, e, f)]
zip6 :: forall a b c d e f.
([a], [b], [c], [d], [e], [f]) <-> [(a, b, c, d, e, f)]
zip6 = (\([a]
a,[b]
b,[c]
c,[d]
d,[e]
e,[f]
f) -> [a] -> [b] -> [c] -> [d] -> [e] -> [f] -> [(a, b, c, d, e, f)]
forall a b c d e f.
[a] -> [b] -> [c] -> [d] -> [e] -> [f] -> [(a, b, c, d, e, f)]
L.zip6 [a]
a [b]
b [c]
c [d]
d [e]
e [f]
f) (([a], [b], [c], [d], [e], [f]) -> [(a, b, c, d, e, f)])
-> ([(a, b, c, d, e, f)] -> ([a], [b], [c], [d], [e], [f]))
-> Bijection
     (->) ([a], [b], [c], [d], [e], [f]) [(a, b, c, d, e, f)]
forall (a :: * -> * -> *) b c. a b c -> a c b -> Bijection a b c
:<->: [(a, b, c, d, e, f)] -> ([a], [b], [c], [d], [e], [f])
forall a b c d e f.
[(a, b, c, d, e, f)] -> ([a], [b], [c], [d], [e], [f])
L.unzip6

-- |'L.zip7' seven lists together.
zip7 :: ([a], [b], [c], [d], [e], [f], [g]) <-> [(a, b, c, d, e, f, g)]
zip7 :: forall a b c d e f g.
([a], [b], [c], [d], [e], [f], [g]) <-> [(a, b, c, d, e, f, g)]
zip7 = (\([a]
a,[b]
b,[c]
c,[d]
d,[e]
e,[f]
f,[g]
g) -> [a]
-> [b]
-> [c]
-> [d]
-> [e]
-> [f]
-> [g]
-> [(a, b, c, d, e, f, g)]
forall a b c d e f g.
[a]
-> [b]
-> [c]
-> [d]
-> [e]
-> [f]
-> [g]
-> [(a, b, c, d, e, f, g)]
L.zip7 [a]
a [b]
b [c]
c [d]
d [e]
e [f]
f [g]
g) (([a], [b], [c], [d], [e], [f], [g]) -> [(a, b, c, d, e, f, g)])
-> ([(a, b, c, d, e, f, g)] -> ([a], [b], [c], [d], [e], [f], [g]))
-> Bijection
     (->) ([a], [b], [c], [d], [e], [f], [g]) [(a, b, c, d, e, f, g)]
forall (a :: * -> * -> *) b c. a b c -> a c b -> Bijection a b c
:<->: [(a, b, c, d, e, f, g)] -> ([a], [b], [c], [d], [e], [f], [g])
forall a b c d e f g.
[(a, b, c, d, e, f, g)] -> ([a], [b], [c], [d], [e], [f], [g])
L.unzip7

-- |'L.zipWith' two lists together using a bijection.
zipWith :: (a, b) <-> c -> ([a], [b]) <-> [(c)]
zipWith :: forall a b c. ((a, b) <-> c) -> ([a], [b]) <-> [c]
zipWith ((a, b) -> c
f :<->: c -> (a, b)
g) = ([a] -> [b] -> [c]) -> ([a], [b]) -> [c]
forall a b c. (a -> b -> c) -> (a, b) -> c
uncurry ((a -> b -> c) -> [a] -> [b] -> [c]
forall a b c. (a -> b -> c) -> [a] -> [b] -> [c]
L.zipWith (((a, b) -> c) -> a -> b -> c
forall a b c. ((a, b) -> c) -> a -> b -> c
curry (a, b) -> c
f)) (([a], [b]) -> [c])
-> ([c] -> ([a], [b])) -> Bijection (->) ([a], [b]) [c]
forall (a :: * -> * -> *) b c. a b c -> a c b -> Bijection a b c
:<->: [(a, b)] -> ([a], [b])
forall a b. [(a, b)] -> ([a], [b])
L.unzip ([(a, b)] -> ([a], [b])) -> ([c] -> [(a, b)]) -> [c] -> ([a], [b])
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (c -> (a, b)) -> [c] -> [(a, b)]
forall a b. (a -> b) -> [a] -> [b]
L.map c -> (a, b)
g

-- |(Un)interleave two lists, e.g., between @([2,5,11],[3,7])@ and @[2,3,5,7,11]@.
interleave :: ([a], [a]) <-> [a]
interleave :: forall a. ([a], [a]) <-> [a]
interleave = ([a] -> [a] -> [a]) -> ([a], [a]) -> [a]
forall a b c. (a -> b -> c) -> (a, b) -> c
uncurry [a] -> [a] -> [a]
forall {a}. [a] -> [a] -> [a]
f (([a], [a]) -> [a])
-> ([a] -> ([a], [a])) -> Bijection (->) ([a], [a]) [a]
forall (a :: * -> * -> *) b c. a b c -> a c b -> Bijection a b c
:<->: [a] -> ([a], [a])
forall {a}. [a] -> ([a], [a])
g where
  f :: [a] -> [a] -> [a]
f (a
x:[a]
xl) (a
y:[a]
yl) = a
xa -> [a] -> [a]
forall a. a -> [a] -> [a]
:a
ya -> [a] -> [a]
forall a. a -> [a] -> [a]
:[a] -> [a] -> [a]
f [a]
xl [a]
yl
  f [] [a]
l = [a]
l
  f [a]
l [] = [a]
l
  g :: [a] -> ([a], [a])
g (a
x:a
y:[a]
l) = (a
xa -> [a] -> [a]
forall a. a -> [a] -> [a]
:) ([a] -> [a]) -> ([a] -> [a]) -> ([a], [a]) -> ([a], [a])
forall b c b' c'. (b -> c) -> (b' -> c') -> (b, b') -> (c, c')
forall (a :: * -> * -> *) b c b' c'.
Arrow a =>
a b c -> a b' c' -> a (b, b') (c, c')
*** (a
ya -> [a] -> [a]
forall a. a -> [a] -> [a]
:) (([a], [a]) -> ([a], [a])) -> ([a], [a]) -> ([a], [a])
forall a b. (a -> b) -> a -> b
$ [a] -> ([a], [a])
g [a]
l 
  g [a]
l = ([a]
l, [])

-- |Split a string into 'L.lines'.
lines :: String <-> [String]
lines :: String <-> [String]
lines = String -> [String]
L.lines (String -> [String]) -> ([String] -> String) -> String <-> [String]
forall (a :: * -> * -> *) b c. a b c -> a c b -> Bijection a b c
:<->: [String] -> String
L.unlines

-- |Split a string into 'L.words'.
words :: String <-> [String]
words :: String <-> [String]
words = String -> [String]
L.words (String -> [String]) -> ([String] -> String) -> String <-> [String]
forall (a :: * -> * -> *) b c. a b c -> a c b -> Bijection a b c
:<->: [String] -> String
L.unwords