separated 0.0.8 → 0.1.0

raw patch · 8 files changed

+666/−752 lines, 8 filesdep +bifunctorsdep +template-haskelldep ~basedep ~lens

Dependencies added: bifunctors, template-haskell

Dependency ranges changed: base, lens

Files

• changelog +8/−0
• etc/LICENCE +1/−1
• separated.cabal +15/−9
• src/Data/Separated.hs +6/−742
• src/Data/Separated/FlipSeparated.hs +203/−0
• src/Data/Separated/FlipSeparatedCons.hs +18/−0
• src/Data/Separated/Separated.hs +397/−0
• src/Data/Separated/SeparatedCons.hs +18/−0

@@ -0,0 +1,8 @@+0.1.0++Refactor and reorganisation of modules.++0.0.8++This change log starts.+

@@ -1,4 +1,4 @@-Copyright 2013 Tony Morris+Copyright 2013-2014 Tony Morris  All rights reserved. 

@@ -1,10 +1,10 @@ name:               separated-version:            0.0.8+version:            0.1.0 license:            BSD3 license-File:       etc/LICENCE author:             Tony Morris <ʇǝu˙sıɹɹoɯʇ@ןןǝʞsɐɥ> maintainer:         Tony Morris-copyright:          Copyright (C) 2013 Tony Morris+copyright:          Copyright (C) 2013-2014 Tony Morris synopsis:           A data type with elements separated by values category:           Data description:        A data type with elements separated by values@@ -12,6 +12,7 @@ bug-reports:        https://github.com/tonymorris/separated/issues cabal-version:      >= 1.10 build-type:         Custom+extra-source-files: changelog  source-repository   head   type:             git@@ -26,9 +27,10 @@    build-depends:                     base < 5 && >= 3-                    , lens >= 3.10+                    , lens >= 4.0                     , semigroups >= 0.9                     , semigroupoids >= 4.0+                    , bifunctors >= 4.0    ghc-options:                     -Wall@@ -41,6 +43,10 @@    exposed-modules:                     Data.Separated+                    Data.Separated.FlipSeparated+                    Data.Separated.FlipSeparatedCons+                    Data.Separated.Separated+                    Data.Separated.SeparatedCons  test-suite doctests   type:@@ -53,11 +59,12 @@                     Haskell2010    build-depends:-                    base < 5 && >= 3,-                    doctest >= 0.9.7,-                    filepath >= 1.3,-                    directory >= 1.1,-                    QuickCheck >= 2.0+                    base < 5 && >= 3+                    , doctest >= 0.9.7+                    , filepath >= 1.3+                    , directory >= 1.1+                    , QuickCheck >= 2.0+                    , template-haskell >= 2.8    ghc-options:                     -Wall@@ -65,4 +72,3 @@    hs-source-dirs:                     test-

@@ -1,746 +1,10 @@-{-# LANGUAGE MultiParamTypeClasses #-}-{-# LANGUAGE TypeFamilies #-}-{-# LANGUAGE GADTs #-}-{-# LANGUAGE StandaloneDeriving #-}+{-# LANGUAGE NoImplicitPrelude #-}  module Data.Separated(-  -- * Data types-  Separated-, Separated'-, Separated1-, Separated1'-, FlipSeparated-, FlipSeparated'-, FlipSeparated1-, FlipSeparated1'-  -- * Inserting elements-, SeparatedCons(..)-, FlipSeparatedCons(..)-, (++:)-, (*+:)-, (**:)-  -- * Constructing data types-, empty-, single-, (+:.)-, fempty-  -- * Extracting values from data types-, allValues-, allValues1-, separatedValues-, separated1Values-, separators-, separators1-  -- * Lenses and isomorphisms-, separatedIso-, separatedSwap-, separated1Iso-, shift-, separated1Head-, separated1Tail-, flipSeparatedIso-, flipSeparatedSwapIso-, flipSeparated1Iso-  -- * Alternating combinators-, separatedWith-, separatedWith1+  module S ) where -import Prelude(Eq, Ord, Show(..), Functor(..), Monad(..), Bool(..), fst, snd, const, id, not, (.))-import Data.List.NonEmpty(NonEmpty(..))-import Data.List(intercalate, zipWith, repeat)-import Control.Lens(Lens', Iso', lens, iso, from, (#), (^.))-import Data.Semigroup(Semigroup(..))-import Data.Monoid(Monoid(..))-import Data.Functor((<$>))-import Data.Maybe(Maybe(..))-import Control.Applicative(Applicative(..), Alternative(many, (<|>)))-import Data.Functor.Apply(Apply(..))---- $setup--- >>> import Prelude(Eq(..), Num(..), String, Int, id)--- >>> import Data.Char(toUpper)--- >>> import Data.List(reverse, drop)--- >>> import Control.Lens(set, (^.))--- >>> import Test.QuickCheck(Arbitrary(..))--- >>> instance (Arbitrary s, Arbitrary a) => Arbitrary (Separated s a) where arbitrary = fmap Separated arbitrary--- >>> instance (Arbitrary a, Arbitrary s) => Arbitrary (Separated1 s a) where arbitrary = do a <- arbitrary; x <- arbitrary; return (Separated1 a x)--- >>> instance (Arbitrary s, Arbitrary a) => Arbitrary (FlipSeparated a s) where arbitrary = fmap FlipSeparated arbitrary--- >>> instance (Arbitrary a, Arbitrary s) => Arbitrary (FlipSeparated1 s a) where arbitrary = do a <- arbitrary; x <- arbitrary; return (FlipSeparated1 a x)---- | A data type representing a list of pairs of separator and element values.-newtype Separated s a =-  Separated [(s, a)]-  deriving (Eq, Ord)--type Separated' x =-  Separated x x--instance (Show s, Show a) => Show (Separated s a) where-  show (Separated x) =-    '[' : intercalate "," (fmap (\(s, a) -> show s <> "," <> show a) x) <> "]"---- | Map across a @Separated@ on the element values.------ prop> fmap id (x :: Separated Int String) == x------ prop> fmap (+1) (a +: b +: empty) == a +: (1+b) +: empty-instance Functor (Separated s) where-  fmap f (Separated x) =-    Separated (fmap (\(a, b) -> (a, f b)) x)---- not exported-separatedAp ::-  (s -> s -> s)-  -> Separated s (a -> b)-  -> Separated s a-  -> Separated s b-separatedAp op (Separated f) (Separated a) =-    Separated (zipWith (\(s, f') (t, a') -> (s `op` t, f' a')) f a)---- | Applies functions with element values, using a zipping operation, appending--- separators.------ >>> (empty :: Separated [Int] (String -> [String])) <.> empty--- []------ >>> [1,2] +: (\s -> [s, reverse s, drop 1 s]) +: empty <.> [3,4,5] +: "abc" +: empty--- [[1,2,3,4,5],["abc","cba","bc"]]-instance Semigroup s => Apply (Separated s) where-  (<.>) =-    separatedAp (<>)---- | Applies functions with element values, using a zipping operation, appending--- separators. The identity operation is an infinite list of the empty separator--- and the given element value.------ >>> (empty :: Separated [Int] (String -> [String])) <*> empty--- []------ >>> [1,2] +: (\s -> [s, reverse s, drop 1 s]) +: empty <*> [3,4,5] +: "abc" +: empty--- [[1,2,3,4,5],["abc","cba","bc"]]-instance Monoid s => Applicative (Separated s) where-  (<*>) =-    separatedAp mappend-  pure a =-    Separated (repeat (mempty, a))---- | A data type representing element values interspersed with a separator.------ There is one fewer separator values (@s@) than there are element values (@a@). There is at least one element value.-data Separated1 a s =-  Separated1 a [(s, a)]-  deriving (Eq, Ord)--type Separated1' x =-  Separated1 x x--instance (Show a, Show s) => Show (Separated1 a s) where-  show (Separated1 a x) =-    '[' : intercalate "," (show a : fmap (\(s, a') -> show s <> "," <> show a') x) <> "]"---- | Map across a @Separated1@ on the separator values.------ >>> fmap (+1) (set separated1Tail (1 +: 'b' +: 2 +: 'c' +: empty) (single 'a'))--- ['a',2,'b',3,'c']------ prop> fmap id (x :: Separated1 Int String) == x------ prop> fmap (+1) (single x) == single x-instance Functor (Separated1 a) where-  fmap f (Separated1 a x) =-    Separated1 a (fmap (\(s, y) -> (f s, y)) x)---- not exported-separated1Ap ::-  (a -> a -> a)-  -> Separated1 a (s -> t)-  -> Separated1 a s-  -> Separated1 a t-separated1Ap op (Separated1 a f) (Separated1 b s) =-  Separated1 (a `op` b) (zipWith (\(f', s') (x, t') -> (f' x, s' `op` t')) f s)---- | Applies functions with separator values, using a zipping operation,--- appending elements.------ >>> [1,2] +: reverse +: [3,4] +: empty <.> [5,6,7] +: "abc" +: [8] +: empty--- [[1,2,5,6,7],"cba",[3,4,8]]-instance Semigroup a => Apply (Separated1 a) where-  (<.>) =-    separated1Ap (<>)---- | Applies functions with separator values, using a zipping operation,--- appending elements. The identity operation is an infinite list of the empty--- element and the given separator value.------ >>> [1,2] +: reverse +: [3,4] +: empty <*> [5,6,7] +: "abc" +: [8] +: empty--- [[1,2,5,6,7],"cba",[3,4,8]]-instance Monoid a => Applicative (Separated1 a) where-  (<*>) =-    separated1Ap mappend-  pure a =-    Separated1 mempty (repeat (a, mempty))---- | Prepend a value to a separated-like structure.------ >>> 'z' +: empty--- ['z']------ >>> 9 +: 'z' +: empty--- [9,'z']-class (f ~ SeparatedConsF g, g ~ SeparatedConsG f) => SeparatedCons f g where-  type SeparatedConsF g :: * -> * -> *-  type SeparatedConsG f :: * -> * -> *-  (+:) ::-    a-    -> f s a-    -> g a s--instance SeparatedCons Separated Separated1 where-  type SeparatedConsF Separated1 = Separated-  type SeparatedConsG Separated = Separated1-  a +: Separated x =-    Separated1 a x--instance SeparatedCons Separated1 Separated where-  type SeparatedConsF Separated = Separated1-  type SeparatedConsG Separated1 = Separated-  s +: Separated1 a x =-    Separated ((s, a) : x)--infixr 5 +:---- | Append two lists of separated values to produce a list of pairs of separator and element values.------ >>> single 7 ++: single 'a'--- [7,'a']------ 'a' +: single 7 ++: single 'b'--- ['a',7,'b']------ prop> a +: (b ++: c) == (a +: b) *+: c-(++:) ::-   Separated1 s a-   -> Separated1 a s-   -> Separated s a-Separated1 s x ++: Separated1 t y =-  let (q, r') = (s, x) ^. separated1Iso . shift-  in Separated (q <> ((r', t) : y))--infixr 5 ++:---- | Append element values interspersed with a separator to a list of pairs of separator and element values.------ >>> empty *+: single 7--- [7]------ >>> empty *+: 6 +: 'x' +: single 7--- [6,'x',7]------ >>> 'w' +: empty *+: 6 +: 'x' +: single 7--- ['w',6,'x',7]-(*+:) ::-  Separated s a-  -> Separated1 s a-  -> Separated1 s a-Separated x *+: Separated1 t y =-  let (z, w') = separated1Iso . shift # (x, t)-  in Separated1 z (w' <> y)--infixr 5 *+:---- | Append a list of pairs of separator and element values to element values interspersed with a separator.------ >>> single 7 **: empty--- [7]------ >>> single 6 **: 'x' +: 7 +: empty--- [6,'x',7]------ >>> 'w' +: single 6 **: 'x' +: 7 +: empty--- ['w',6,'x',7]-(**:) ::-  Separated1 a s-  -> Separated s a-  -> Separated1 a s-Separated1 a x **: Separated y =-  Separated1 a (x <> y)--infixr 5 **:---- | An empty list of pairs of separator and element values.------ >>> empty--- []------ prop> empty *+: x == x------ prop> x **: empty == x-empty ::-  Separated a s-empty =-  Separated []---- | Zero element values interspersed with one element.------ >>> single 4--- [4]------ prop> single x ^. separated1Tail == empty-single ::-  a-  -> Separated1 a s-single a =-  Separated1 a []---- | One element and one separator.------ >>> 7 +:. "abc"--- [7,"abc"]------ >>> 7 +: "abc" +: 8 +:. "def"--- [7,"abc",8,"def"]-(+:.) ::-  a-  -> s-  -> Separated a s-(+:.) a s =-  a +: single s--infixr 5 +:.---- | Return all element values in a list of pairs of element and separator values.------ >>> separatedValues empty--- []------ >>> separatedValues ('x' +: 2 +: empty)--- [2]-separatedValues ::-  Separated s a-  -> [a]-separatedValues (Separated x) =-  fmap snd x---- | Return all element values.------ >>> separated1Values (single 8)--- 8 :| []------ >>> separated1Values (7 +: 'a' +: single 8)--- 7 :| [8]------ prop> let h :| _ = separated1Values (single x) in h == (x :: Int)------ prop> let _ :| t = separated1Values (d +: e +: single x) in t == fmap fst [e]-separated1Values ::-  Separated1 a s-  -> NonEmpty a-separated1Values (Separated1 a x) =-  a :| fmap snd x---- | Return all separator values.------ >>> separators empty--- []------ >>> separators ('x' +: 2 +: empty)--- "x"-separators ::-  Separated s a-  -> [s]-separators (Separated x) =-  fmap fst x---- | Return all separator values.------ >>> separators ('a' +: single 7)--- "a"------ >>> separators ('a' +: 6 +:'b' +: single 7)--- "ab"------ prop> separators (a +: single x) == [a]-separators1 ::-  Separated1 a s-  -> [s]-separators1 (Separated1 _ x) =-  fmap fst x---- | Extract all values, where the separator and element are the same type.------ >>> allValues empty--- []------ >>> allValues (1 +: 2 +: 3 +: 4 +: empty)--- [1,2,3,4]-allValues ::-  Separated' a-  -> [a]-allValues (Separated x) =-  x >>= \(s, a') -> [s, a']---- | Extract all values, where the separator and element are the same type.------ >>> allValues1 (single 7)--- 7 :| []------ >>> allValues1 (1 +: 2 +: 3 +: empty)--- 1 :| [2,3]-allValues1 ::-  Separated1' a-  -> NonEmpty a-allValues1 (Separated1 a x) =-  a :| (x >>= \(s, a') -> [s, a'])---- | The isomorphism to a list of pairs of element and separator values.------ >>> separatedIso # empty--- []------ >>> separatedIso # ('x' +: 6 +: empty)--- [('x',6)]------ >>> [] ^. separatedIso--- []------ >>> [(6, [])] ^. separatedIso--- [6,[]]-separatedIso ::-  Iso' [(s, a)] (Separated s a)-separatedIso =-  iso Separated (\(Separated x) -> x)---- | The isomorphism that swaps elements with their separators.------ >>> separatedSwap # empty--- []------ >>> separatedSwap # ('x' +: 6 +: empty)--- [6,'x']------ >>> empty ^. separatedSwap--- []------ >>> ('x' +: 6 +: empty) ^. separatedSwap--- [6,'x']-separatedSwap ::-  Iso' (Separated s a) (Separated a s)-separatedSwap =-  let swap (a, b) = (b, a)-  in iso (\(Separated x) -> Separated (fmap swap x)) (\(Separated x) -> Separated (fmap swap x))---- | The isomorphism to element values interspersed with a separator.------ >>> separated1Iso # (single 6)--- (6,[])------ >>> separated1Iso # (5 +: 'x' +: single 6)--- (5,[('x',6)])------ >>> (6, []) ^. separated1Iso--- [6]------ >>> (5, [('x', 6)]) ^. separated1Iso--- [5,'x',6]-separated1Iso ::-  Iso' (a, [(s, a)]) (Separated1 a s)-separated1Iso =-  iso (\(a, x) -> Separated1 a x) (\(Separated1 a x) -> (a, x))---- | The isomorphism that shuffles the elements and separators one position.------ >>> shift # ([], 6)--- [6]------ >>> shift # ([(5, 'x')], 6)--- [5,'x',6]------ >>> single 6 ^. shift--- ([],6)------ >>> (5 +: 'x' +: single 6) ^. shift--- ([(5,'x')],6)-shift ::-  Iso' (Separated1 a s) ([(a, s)], a)-shift =-  let shiftR ([], a) =-        Separated1 a []-      shiftR ((b, s):r, a) =-        let Separated1 z' w = shiftR (r, b)-        in Separated1 z' ((s, a) : w)-      shiftL (Separated1 s' []) =-        ([], s')-      shiftL (Separated1 s' ((a, t') : r)) =-        let (w, z) = shiftL (Separated1 t' r)-        in ((s', a) : w, z)-  in iso shiftL shiftR---- | A lens on the first element value.------ >>> single 7 ^. separated1Head--- 7------ prop> single x ^. separated1Head == (x :: Int)-separated1Head ::-  Lens' (Separated1 a s) a-separated1Head =-  lens (\(Separated1 a _) -> a) (\(Separated1 _ x) a -> Separated1 a x)---- | A lens on the tail.------ prop> d +: e +: single x ^. separated1Tail == e +: x +: empty-separated1Tail ::-  Lens' (Separated1 a s) (Separated s a)-separated1Tail =-  lens (\(Separated1 _ x) -> Separated x) (\(Separated1 a _) (Separated x) -> Separated1 a x)---- | Effectful separation with failure represented by @Nothing@.------ >>> separatedWith Nothing Nothing--- Just Nothing------ >>> separatedWith Nothing (Just 7)--- Just Nothing------ >>> separatedWith (Just 'x') Nothing--- Just (Just ['x'])------ >>> separatedWith [] []--- [Nothing]------ >>> separatedWith [] [1,2,3]--- [Nothing]------ >>> separatedWith [1,2,3] []--- [Just [1],Just [2],Just [3],Nothing]-separatedWith ::-  Alternative f =>-  f s-  -> f a-  -> f (Maybe (Separated1 s a))-separatedWith a s =-  Just <$> separatedWith1 a s <|> pure Nothing---- | Effectful separation.------ >>> separatedWith1 Nothing Nothing--- Nothing------ >>> separatedWith1 Nothing (Just 7)--- Nothing------ >>> separatedWith1 (Just 'x') Nothing--- Just ['x']------ >>> separatedWith1 [] []--- []------ >>> separatedWith1 [] [1,2,3]--- []------ >>> separatedWith1 [1,2,3] []--- [[1],[2],[3]]-separatedWith1 ::-  Alternative f =>-  f a-  -> f s-  -> f (Separated1 a s)-separatedWith1 a s =-  Separated1 <$> a <*> many ((,) <$> s <*> a)---- | A data type representing a list of pairs of separator and element values.--- Isomorphic to @Separated@ with the type constructor flipped.-newtype FlipSeparated a s =-  FlipSeparated [(s, a)]-  deriving (Eq, Ord)--type FlipSeparated' x =-  FlipSeparated x x--fempty ::-  FlipSeparated a s-fempty =-  FlipSeparated []---- | The isomorphism to a @Separator@.------ >>> flipSeparatedIso # empty--- []------ >>> flipSeparatedIso # ('x' +: 6 +: empty)--- ['x',6]------ >>> [] ^. separatedIso . from flipSeparatedIso--- []------ >>> [(6, [])] ^. separatedIso . from flipSeparatedIso--- [6,[]]-flipSeparatedIso ::-  Iso' (FlipSeparated a s) (Separated s a)-flipSeparatedIso =-  iso (\(FlipSeparated x) -> Separated x) (\(Separated x) -> FlipSeparated x)---- | The isomorphism to a @Separator@ with elements and separators swapped.--- >>> flipSeparatedSwapIso # empty--- []------ >>> flipSeparatedSwapIso # ('x' +: 6 +: empty)--- [6,'x']------ >>> [] ^. separatedIso . from flipSeparatedSwapIso--- []------ >>> [(6, [])] ^. separatedIso . from flipSeparatedSwapIso--- [[],6]-flipSeparatedSwapIso ::-    Iso' (FlipSeparated a s) (Separated a s)-flipSeparatedSwapIso =-  flipSeparatedIso . separatedSwap--instance (Show a, Show s) => Show (FlipSeparated a s) where-  show x =-    show (x ^. flipSeparatedIso)---- | Map across a @FlipSeparated@ on the separator values.------ prop> fmap id (x :: FlipSeparated Int String) == x------ prop> fmap (+1) (a +. b +. fempty) == (1+a) +. b +. fempty-instance Functor (FlipSeparated a) where-  fmap f x =-    fmap f (x ^. flipSeparatedSwapIso) ^. from flipSeparatedSwapIso---- not exported-flipSeparatedAp ::-  (a -> a -> a)-  -> FlipSeparated a (s -> t)-  -> FlipSeparated a s-  -> FlipSeparated a t-flipSeparatedAp op f a =-    let f' = f ^. flipSeparatedSwapIso-        a' = a ^. flipSeparatedSwapIso-    in separatedAp op f' a' ^. from flipSeparatedSwapIso---- | Applies functions with separator values, using a zipping operation,--- appending elements.------ >>> (fempty :: FlipSeparated [Int] (String -> [String])) <.> fempty--- []------ >>> (\s -> [s, reverse s, drop 1 s]) +. [1,2] +. fempty <.> "abc" +. [3,4,5] +. fempty--- [["abc","cba","bc"],[1,2,3,4,5]]-instance Semigroup a => Apply (FlipSeparated a) where-  (<.>) =-    flipSeparatedAp (<>)---- | Applies functions with separator values, using a zipping operation, appending--- elements. The identity operation is an infinite list of the empty element--- and the given separator value.------ >>> (fempty :: FlipSeparated [Int] (String -> [String])) <*> fempty--- []------ >>> (\s -> [s, reverse s, drop 1 s]) +. [1,2] +. fempty <*> "abc" +. [3,4,5] +. fempty--- [["abc","cba","bc"],[1,2,3,4,5]]-instance Monoid a => Applicative (FlipSeparated a) where-  (<*>) =-    flipSeparatedAp mappend-  pure s =-    FlipSeparated (repeat (s, mempty))---- | A data type representing element values interspersed with a separator.--- Isomorphic to @Separated1@ with the type constructor flipped.------ There is one fewer separator values (@s@) than there are element values (@a@). There is at least one element value.-data FlipSeparated1 s a =-  FlipSeparated1 a [(s, a)]-  deriving (Eq, Ord)--type FlipSeparated1' x =-  FlipSeparated1 x x---- | The isomorphism to a @Separated1@.------ >>> flipSeparated1Iso # (single 6)--- [6]------ >>> flipSeparated1Iso # (5 +: 'x' +: single 6)--- [5,'x',6]------ >>> (6 +: empty) ^. from flipSeparated1Iso--- [6]------ >>> (5 +: 'x' +: 6 +: empty) ^. from flipSeparated1Iso--- [5,'x',6]-flipSeparated1Iso ::-  Iso' (FlipSeparated1 s a) (Separated1 a s)-flipSeparated1Iso =-  iso (\(FlipSeparated1 s x) -> Separated1 s x) (\(Separated1 s x) -> FlipSeparated1 s x)--instance (Show s, Show a) => Show (FlipSeparated1 s a) where-  show x =-    show (x ^. flipSeparated1Iso)--instance Functor (FlipSeparated1 s) where-  fmap f (FlipSeparated1 a x) =-    FlipSeparated1 (f a) (fmap (\(s, y) -> (s, f y)) x)---- not exported-flipSeparated1Ap ::-  (s -> s -> s)-  -> FlipSeparated1 s (a -> b)-  -> FlipSeparated1 s a-  -> FlipSeparated1 s b-flipSeparated1Ap op (FlipSeparated1 f s) (FlipSeparated1 a t) =-  FlipSeparated1 (f a) (zipWith (\(s', f') (t', x) -> (s' `op` t', f' x)) s t)---- | Applies functions with element values, using a zipping operation,--- appending separators.------ >>> fmap toUpper +. [3,4] +. reverse +. fempty <.> "abc" +. [5,6,7] +. "def" +. fempty--- ["ABC",[3,4,5,6,7],"fed"]-instance Semigroup s => Apply (FlipSeparated1 s) where-  (<.>) =-    flipSeparated1Ap (<>)---- | Applies functions with element values, using a zipping operation,--- appending separators. The identity operation is an infinite list of the empty--- separator and the given element value.------ >>> fmap toUpper +. [3,4] +. reverse +. fempty <*> "abc" +. [5,6,7] +. "def" +. fempty--- ["ABC",[3,4,5,6,7],"fed"]-instance Monoid s => Applicative (FlipSeparated1 s) where-  (<*>) =-    flipSeparated1Ap mappend-  pure s =-    FlipSeparated1 s (repeat (mempty, s))---- | Prepend a value to a flipped separated-like structure.------ >>> 'z' +. fempty--- ['z']------ >>> 9 +. 'z' +. fempty--- [9,'z']-class (f ~ FlipSeparatedConsF g, g ~ FlipSeparatedConsG f) => FlipSeparatedCons f g where-  type FlipSeparatedConsF g :: * -> * -> *-  type FlipSeparatedConsG f :: * -> * -> *-  (+.) ::-    s-    -> f s a-    -> g a s--infixr 5 +.--instance FlipSeparatedCons FlipSeparated1 FlipSeparated where-  type FlipSeparatedConsF FlipSeparated = FlipSeparated1-  type FlipSeparatedConsG FlipSeparated1 = FlipSeparated-  s +. p =-    (s +: p ^. flipSeparated1Iso) ^. from flipSeparatedIso--instance FlipSeparatedCons FlipSeparated FlipSeparated1 where-  type FlipSeparatedConsF FlipSeparated1 = FlipSeparated-  type FlipSeparatedConsG FlipSeparated = FlipSeparated1-  a +. p =-    (a +: p ^. flipSeparatedIso) ^. from flipSeparated1Iso+import Data.Separated.FlipSeparated as S+import Data.Separated.FlipSeparatedCons as S+import Data.Separated.Separated as S+import Data.Separated.SeparatedCons as S

@@ -0,0 +1,203 @@+{-# LANGUAGE NoImplicitPrelude #-}+{-# LANGUAGE TypeFamilies #-}+{-# LANGUAGE MultiParamTypeClasses #-}++module Data.Separated.FlipSeparated(+  FlipSeparated+, flipSeparated+, flipSeparated1+, fempty+) where++import Control.Applicative(Applicative(pure, (<*>)))+import Control.Category(Category(id, (.)))+import Control.Lens.Getter((^.))+import Control.Lens.Iso(Iso, iso)+import Control.Lens.Review((#))+import Data.Bifunctor(Bifunctor(bimap))+import Data.Eq(Eq)+import Data.Functor(Functor(fmap))+import Data.Functor.Apply(Apply((<.>)))+import Data.List(zipWith)+import Data.Monoid(Monoid(mappend, mempty))+import Data.Ord(Ord)+import Data.Semigroup(Semigroup((<>)))+import Data.Separated.FlipSeparatedCons(FlipSeparatedCons(FlipSeparatedConsF, FlipSeparatedConsG, (+.)))+import Data.Separated.Separated(Separated, Separated1, separated, separated1, separatedSwap, empty)+import Data.Separated.SeparatedCons((+:))+import Prelude(Show(show))++-- $setup+-- >>> :set -XNoImplicitPrelude+-- >>> import Control.Monad(Monad(return))+-- >>> import Data.Char(toUpper)+-- >>> import Data.Int(Int)+-- >>> import Data.Eq(Eq((==)))+-- >>> import Data.List(reverse, drop)+-- >>> import Data.Separated.Separated(empty, single)+-- >>> import Data.String(String)+-- >>> import Prelude(Num((+)))+-- >>> import Test.QuickCheck(Arbitrary(..))+-- >>> instance (Arbitrary s, Arbitrary a) => Arbitrary (Separated s a) where arbitrary = fmap (^. separated) arbitrary+-- >>> instance (Arbitrary a, Arbitrary s) => Arbitrary (Separated1 s a) where arbitrary = do a <- arbitrary; x <- arbitrary; return ((a, x) ^. separated1)+-- >>> instance (Arbitrary s, Arbitrary a) => Arbitrary (FlipSeparated a s) where arbitrary = fmap FlipSeparated arbitrary+-- >>> instance (Arbitrary a, Arbitrary s) => Arbitrary (FlipSeparated1 s a) where arbitrary = do a <- arbitrary; return (FlipSeparated1 a)++newtype FlipSeparated a s =+  FlipSeparated (Separated s a)+  deriving (Eq, Ord)++instance Bifunctor FlipSeparated where+  bimap f g (FlipSeparated x) =+    FlipSeparated (bimap g f x)++-- | Map across a @FlipSeparated@ on the separator values.+--+-- prop> fmap id (x :: FlipSeparated Int String) == x+--+-- prop> fmap (+1) (a +. b +. fempty) == (1+a) +. b +. fempty+instance Functor (FlipSeparated a) where+  fmap =+    bimap id++-- | Applies functions with separator values, using a zipping operation,+-- appending elements.+--+-- >>> (fempty :: FlipSeparated [Int] (String -> [String])) <.> fempty+-- []+--+-- >>> (\s -> [s, reverse s, drop 1 s]) +. [1,2] +. fempty <.> "abc" +. [3,4,5] +. fempty+-- [["abc","cba","bc"],[1,2,3,4,5]]+instance Semigroup a => Apply (FlipSeparated a) where+  FlipSeparated x <.> FlipSeparated y =+    FlipSeparated (separatedSwap # (x ^. separatedSwap <.> y ^. separatedSwap))++-- | Applies functions with separator values, using a zipping operation, appending+-- elements. The identity operation is an infinite list of the empty element+-- and the given separator value.+--+-- >>> (fempty :: FlipSeparated [Int] (String -> [String])) <*> fempty+-- []+--+-- >>> (\s -> [s, reverse s, drop 1 s]) +. [1,2] +. fempty <*> "abc" +. [3,4,5] +. fempty+-- [["abc","cba","bc"],[1,2,3,4,5]]+instance Monoid s => Applicative (FlipSeparated s) where    +  FlipSeparated x <*> FlipSeparated y =+    FlipSeparated (separatedSwap # (x ^. separatedSwap <*> y ^. separatedSwap))+  pure =+    FlipSeparated . (#) separatedSwap . pure++instance (Show s, Show a) => Show (FlipSeparated s a) where+  show (FlipSeparated x) =+    show x++instance Semigroup (FlipSeparated s a) where+  FlipSeparated x <> FlipSeparated y =+    FlipSeparated (x <> y)    ++instance Monoid (FlipSeparated s a) where+  mappend =+    (<>)+  mempty =+    FlipSeparated mempty++instance FlipSeparatedCons FlipSeparated1 FlipSeparated where+  type FlipSeparatedConsF FlipSeparated = FlipSeparated1+  type FlipSeparatedConsG FlipSeparated1 = FlipSeparated+  s +. p =+    (s +: flipSeparated1 # p) ^. flipSeparated++-- | The isomorphism to a @Separator@.+--+-- >>> empty ^. flipSeparated+-- []+--+-- >>> ('x' +: 6 +: empty) ^. flipSeparated+-- ['x',6]+--+-- >>> [] ^. separated . flipSeparated+-- []+--+-- >>> [(6, [])] ^. separated . flipSeparated+-- [6,[]]+flipSeparated ::+  Iso (Separated s a) (Separated t b) (FlipSeparated a s) (FlipSeparated b t) +flipSeparated =+  iso FlipSeparated (\(FlipSeparated x) -> x) ++fempty ::+  FlipSeparated a s+fempty =+  FlipSeparated empty++newtype FlipSeparated1 s a =+  FlipSeparated1 (Separated1 a s)++instance Bifunctor FlipSeparated1 where+  bimap f g (FlipSeparated1 x) =+    FlipSeparated1 (bimap g f x)++instance Functor (FlipSeparated1 a) where+  fmap =+    bimap id++-- | Applies functions with element values, using a zipping operation,+-- appending separators.+--+-- >>> fmap toUpper +. [3,4] +. reverse +. fempty <.> "abc" +. [5,6,7] +. "def" +. fempty+-- ["ABC",[3,4,5,6,7],"fed"]+instance Semigroup a => Apply (FlipSeparated1 a) where+  (<.>) =+    flipSeparated1Ap (<>)++-- | Applies functions with element values, using a zipping operation,+-- appending separators. The identity operation is an infinite list of the empty+-- separator and the given element value.+--+-- >>> fmap toUpper +. [3,4] +. reverse +. fempty <*> "abc" +. [5,6,7] +. "def" +. fempty+-- ["ABC",[3,4,5,6,7],"fed"]+instance Monoid s => Applicative (FlipSeparated1 s) where    +  (<*>) =+    flipSeparated1Ap mappend+  pure a =+    FlipSeparated1 ((a, pure a) ^. separated1)++instance (Show s, Show a) => Show (FlipSeparated1 s a) where+  show (FlipSeparated1 x) =+    show x++-- | The isomorphism to a @Separated1@.+--+-- >>>  single 6 ^. flipSeparated1+-- [6]+--+-- >>>  (5 +: 'x' +: single 6) ^. flipSeparated1+-- [5,'x',6]+--+-- >>> (6 +: empty) ^. flipSeparated1+-- [6]+--+-- >>> (5 +: 'x' +: 6 +: empty) ^. flipSeparated1+-- [5,'x',6]+flipSeparated1 ::+  Iso (Separated1 a s) (Separated1 b t) (FlipSeparated1 s a) (FlipSeparated1 t b)+flipSeparated1 =+  iso FlipSeparated1 (\(FlipSeparated1 x) -> x)++instance FlipSeparatedCons FlipSeparated FlipSeparated1 where+  type FlipSeparatedConsF FlipSeparated1 = FlipSeparated+  type FlipSeparatedConsG FlipSeparated = FlipSeparated1+  a +. p =+    (a +: flipSeparated # p) ^. flipSeparated1++----++flipSeparated1Ap ::+  (s -> s -> s)+  -> FlipSeparated1 s (a -> b)+  -> FlipSeparated1 s a+  -> FlipSeparated1 s b+flipSeparated1Ap op (FlipSeparated1 x) (FlipSeparated1 y) =+  let (f, fs) = separated1 # x+      (a, as) = separated1 # y+  in FlipSeparated1 ((f a, zipWith (\(s, f') (t, a') -> (s `op` t, f' a')) (separated # fs) (separated # as) ^. separated) ^. separated1) 

@@ -0,0 +1,18 @@+{-# LANGUAGE NoImplicitPrelude #-}+{-# LANGUAGE TypeFamilies #-}+{-# LANGUAGE MultiParamTypeClasses #-}++module Data.Separated.FlipSeparatedCons(+  FlipSeparatedCons(..)+) where++-- | Prepend a value to a separated-like structure.+class (f ~ FlipSeparatedConsF g, g ~ FlipSeparatedConsG f) => FlipSeparatedCons f g where+  type FlipSeparatedConsF g :: * -> * -> *+  type FlipSeparatedConsG f :: * -> * -> *+  (+.) ::+    s+    -> f s a+    -> g a s++infixr 5 +.

@@ -0,0 +1,397 @@+{-# LANGUAGE NoImplicitPrelude #-}+{-# LANGUAGE TypeFamilies #-}+{-# LANGUAGE MultiParamTypeClasses #-}++module Data.Separated.Separated(+  Separated+, separated+, Separated1+, separated1+, separated1Head+, separated1Tail+, empty+, (+-)+, single+, shift+, separatedSwap+, (.++.)+, (++.)+, (.++)+) where++import Control.Applicative(Applicative((<*>), pure))+import Control.Category(Category(id, (.)))+import Control.Lens.Iso(Iso, iso, from)+import Control.Lens.Tuple(_1, _2)+import Control.Lens.Type(Lens)+import Data.Functor(Functor(fmap))+import Data.Functor.Apply(Apply((<.>)))+import Data.Bifunctor(Bifunctor(bimap))+import Data.Eq(Eq)+import Data.List(intercalate, zipWith, repeat)+import Data.Monoid(Monoid(mappend, mempty))+import Data.Ord(Ord)+import Data.Semigroup(Semigroup((<>)))+import Data.Separated.SeparatedCons(SeparatedCons((+:), SeparatedConsF, SeparatedConsG))+import Data.String(String)+import Data.Tuple(uncurry)+import Prelude(Show(show))+import Control.Lens((^.), (#))++-- $setup+-- >>> :set -XNoImplicitPrelude+-- >>> import Control.Lens.Review((#))+-- >>> import Control.Monad(Monad(return))+-- >>> import Data.Char(toUpper)+-- >>> import Data.Eq(Eq((==)))+-- >>> import Data.List(reverse, drop)+-- >>> import Control.Lens(set, (^.))+-- >>> import Prelude(Num(..), String, Int)+-- >>> import Test.QuickCheck(Arbitrary(..))+-- >>> instance (Arbitrary s, Arbitrary a) => Arbitrary (Separated s a) where arbitrary = fmap (^. separated) arbitrary+-- >>> instance (Arbitrary a, Arbitrary s) => Arbitrary (Separated1 s a) where arbitrary = do a <- arbitrary; x <- arbitrary; return ((a, x) ^. separated1)++data Separated s a =+  Separated [(s, a)]+  deriving (Eq, Ord)++instance Bifunctor Separated where+  bimap f g (Separated x) =+    Separated (fmap (bimap f g) x)++-- | Map across a @Separated@ on the element values.+--+-- prop> fmap id (x :: Separated Int String) == x+--+-- prop> fmap (+1) (a +: b +: empty) == a +: (1+b) +: empty+instance Functor (Separated s) where+  fmap =+    bimap id++-- | Applies functions with element values, using a zipping operation, appending+-- separators.+--+-- >>> (empty :: Separated [Int] (String -> [String])) <.> empty+-- []+--+-- >>> [1,2] +: (\s -> [s, reverse s, drop 1 s]) +: empty <.> [3,4,5] +: "abc" +: empty+-- [[1,2,3,4,5],["abc","cba","bc"]]+instance Semigroup s => Apply (Separated s) where+  (<.>) =+    separatedAp (<>)++-- | Applies functions with element values, using a zipping operation, appending+-- separators. The identity operation is an infinite list of the empty separator+-- and the given element value.+--+-- >>> (empty :: Separated [Int] (String -> [String])) <*> empty+-- []+--+-- >>> [1,2] +: (\s -> [s, reverse s, drop 1 s]) +: empty <*> [3,4,5] +: "abc" +: empty+-- [[1,2,3,4,5],["abc","cba","bc"]]+instance Monoid s => Applicative (Separated s) where    +  (<*>) =+    separatedAp mappend+  pure =+    Separated . repeat . (,) mempty++instance (Show s, Show a) => Show (Separated s a) where+  show (Separated x) =+    showSeparated id x++instance Semigroup (Separated s a) where+  Separated x <> Separated y =+    Separated (x <> y)    ++instance Monoid (Separated s a) where+  mappend =+    (<>)+  mempty =+    Separated mempty++instance SeparatedCons Separated1 Separated where+  type SeparatedConsF Separated = Separated1+  type SeparatedConsG Separated1 = Separated+  s +: Separated1 a (Separated x) =+    Separated ((s, a) : x)++-- | The isomorphism to a list of pairs of element and separator values.+--+-- >>> separated # empty+-- []+--+-- >>> separated # ('x' +: 6 +: empty)+-- [('x',6)]+--+-- >>> [] ^. separated+-- []+--+-- >>> [(6, [])] ^. separated+-- [6,[]]+separated ::+  Iso [(s, a)] [(t, b)] (Separated s a) (Separated t b)+separated =+  iso Separated (\(Separated x) -> x)++----++data Separated1 a s =+  Separated1 a (Separated s a)+  deriving (Eq, Ord)++instance Bifunctor Separated1 where+  bimap f g (Separated1 a x) =+    Separated1 (f a) (bimap g f x)++-- | Map across a @Separated1@ on the separator values.+--+-- >>> fmap (+1) (set separated1Tail (1 +: 'b' +: 2 +: 'c' +: empty) (single 'a'))+-- ['a',2,'b',3,'c']+--+-- prop> fmap id (x :: Separated1 Int String) == x+--+-- prop> fmap (+1) (single x) == single x+instance Functor (Separated1 s) where+  fmap =+    bimap id++-- | Applies functions with separator values, using a zipping operation,+-- appending elements.+--+-- >>> [1,2] +: reverse +: [3,4] +: empty <.> [5,6,7] +: "abc" +: [8] +: empty+-- [[1,2,5,6,7],"cba",[3,4,8]]+instance Semigroup s => Apply (Separated1 s) where+  (<.>) =+    separated1Ap (<>)++instance (Show a, Show s) => Show (Separated1 a s) where+  show (Separated1 a (Separated x)) =+    showSeparated (show a:) x+    +-- | Applies functions with separator values, using a zipping operation,+-- appending elements. The identity operation is an infinite list of the empty+-- element and the given separator value.+--+-- >>> [1,2] +: reverse +: [3,4] +: empty <*> [5,6,7] +: "abc" +: [8] +: empty+-- [[1,2,5,6,7],"cba",[3,4,8]]+instance Monoid s => Applicative (Separated1 s) where    +  (<*>) =+    separated1Ap mappend+  pure =+    Separated1 mempty . swapSeparated . pure++-- | The isomorphism to element values interspersed with a separator.+--+-- >>> separated1 # (single 6)+-- (6,[])+--+-- >>> separated1 # (5 +: 'x' +: single 6)+-- (5,['x',6])+--+-- >>> (6, empty) ^. separated1+-- [6]+--+-- >>> (5, 'x' +- 6) ^. separated1+-- [5,'x',6]+separated1 ::+  Iso (a, Separated s a) (b, Separated t b) (Separated1 a s) (Separated1 b t)+separated1 =+  iso (uncurry Separated1) (\(Separated1 a x) -> (a, x))++instance SeparatedCons Separated Separated1 where+  type SeparatedConsF Separated1 = Separated+  type SeparatedConsG Separated = Separated1+  (+:) =+    Separated1++-- | A lens on the first element value.+--+-- >>> single 7 ^. separated1Head+-- 7+--+-- prop> single x ^. separated1Head == (x :: Int)+separated1Head ::+  Lens (Separated1 a t) (Separated1 a t) a a+separated1Head =+  from separated1 . _1++-- | A lens on the tail.+--+-- prop> (d +: e +: single x) ^. separated1Tail == e +: x +: empty+separated1Tail ::+  Lens (Separated1 a s) (Separated1 a t) (Separated s a) (Separated t a)+separated1Tail =+  from separated1 . _2++----++empty ::+  Separated s a+empty =+  Separated []++-- | One element and one separator.+--+-- >>> 7 +- "abc"+-- [7,"abc"]+--+-- >>> 7 +: "abc" +: 8 +- "def"+-- [7,"abc",8,"def"]+(+-) ::+  s+  -> a+  -> Separated s a+s +- a =+  s +: single a++-- | Zero element values interspersed with one element.+--+-- >>> single 4+-- [4]+--+-- prop> single x ^. separated1Tail == empty+single ::+  a+  -> Separated1 a s+single a =+  Separated1 a empty++-- | The isomorphism that shuffles the elements and separators one position.+--+-- >>> shift # ([], 6)+-- [6]+--+-- >>> shift # ([(5, 'x')], 6)+-- [5,'x',6]+--+-- >>> single 6 ^. shift+-- ([],6)+--+-- >>> (5 +: 'x' +: single 6) ^. shift+-- ([(5,'x')],6)+shift ::+  Iso (Separated1 a s) (Separated1 b t) ([(a, s)], a) ([(b, t)], b)+shift =+  let shiftR ([], a) =+        Separated1 a (Separated [])+      shiftR ((b, s):r, a) =+        let Separated1 z' (Separated w) = shiftR (r, b)+        in Separated1 z' (Separated ((s, a) : w))+      shiftL (Separated1 s' (Separated [])) =+        ([], s')+      shiftL (Separated1 s' (Separated ((a, t') : r))) =+        let (w, z) = shiftL (Separated1 t' (Separated r))+        in ((s', a) : w, z)+  in iso shiftL shiftR++-- | The isomorphism that swaps elements with their separators.+--+-- >>> separatedSwap # empty+-- []+--+-- >>> separatedSwap # ('x' +: 6 +: empty)+-- [6,'x']+--+-- >>> empty ^. separatedSwap+-- []+--+-- >>> ('x' +: 6 +: empty) ^. separatedSwap+-- [6,'x']+separatedSwap ::+  Iso (Separated s a) (Separated t b) (Separated a s) (Separated b t)+separatedSwap =+  let swap (a, b) = (b, a)+  in iso (\(Separated x) -> Separated (fmap swap x)) (\(Separated x) -> Separated (fmap swap x))+++-- | Append two lists of separated values to produce a list of pairs of separator and element values.+--+-- >>> single 7 .++. single 'a'+-- [7,'a']+--+-- 'a' +: single 7 .++. single 'b'+-- ['a',7,'b']+--+-- prop> a +: (b .++. c) == (a +: b) *+: c+(.++.) ::+   Separated1 s a+   -> Separated1 a s+   -> Separated s a+Separated1 s x .++. Separated1 t (Separated y) =+  let (q, r') = (s, x) ^. separated1 . shift+  in Separated (q <> ((r', t) : y)) ++infixr 5 .++.++-- | Append element values interspersed with a separator to a list of pairs of separator and element values.+--+-- >>> empty ++. single 7+-- [7]+--+-- >>> empty ++. 6 +: 'x' +: single 7+-- [6,'x',7]+--+-- >>> 'w' +: empty ++. 6 +: 'x' +: single 7+-- ['w',6,'x',7]+(++.) ::+  Separated s a+  -> Separated1 s a+  -> Separated1 s a+Separated x ++. Separated1 t y =+  let (z, w') = separated1 . shift # (x, t)+  in Separated1 z (w' <> y)++infixr 5 ++.++-- | Append a list of pairs of separator and element values to element values interspersed with a separator.+--+-- >>> single 7 .++ empty+-- [7]+--+-- >>> single 6 .++ 'x' +: 7 +: empty+-- [6,'x',7]+--+-- >>> 'w' +: single 6 .++ 'x' +: 7 +: empty+-- ['w',6,'x',7]+(.++) ::+  Separated1 a s+  -> Separated s a+  -> Separated1 a s+Separated1 a x .++ y =+  Separated1 a (x <> y)++infixr 5 .++++--- -- values, separators, lookup, FlipSeparated, combinators++----++showSeparated ::+ (Show a, Show s, Functor f) =>+ (f String -> [String])+ -> f (s, a)+ -> String+showSeparated f x =+  '[' : intercalate "," (f (fmap (\(s, a) -> show s <> "," <> show a) x)) <> "]"++separatedAp ::+  (s -> s -> s)+  -> Separated s (a -> b)+  -> Separated s a+  -> Separated s b+separatedAp op (Separated f) (Separated a) =+    Separated (zipWith (\(s, f') (t, a') -> (s `op` t, f' a')) f a)  ++separated1Ap ::+  (a -> a -> a)+  -> Separated1 a (s -> t)+  -> Separated1 a s+  -> Separated1 a t+separated1Ap op (Separated1 f (Separated fs)) (Separated1 a (Separated as)) =+    Separated1 (f `op` a) (Separated (zipWith (\(s, f') (t, a') -> (s t, f' `op` a')) fs as))++swapSeparated ::+  Separated s a+  -> Separated a s+swapSeparated (Separated x) =+  Separated (fmap (\(s, a) -> (a, s)) x)

@@ -0,0 +1,18 @@+{-# LANGUAGE NoImplicitPrelude #-}+{-# LANGUAGE TypeFamilies #-}+{-# LANGUAGE MultiParamTypeClasses #-}++module Data.Separated.SeparatedCons(+  SeparatedCons(..)+) where++-- | Prepend a value to a separated-like structure.+class (f ~ SeparatedConsF g, g ~ SeparatedConsG f) => SeparatedCons f g where+  type SeparatedConsF g :: * -> * -> *+  type SeparatedConsG f :: * -> * -> *+  (+:) ::+    a+    -> f s a+    -> g a s++infixr 5 +: