Separated things using separated with optional trailing comma.

Seppy.hs

module Seppy where

import Control.Applicative (liftA2, (<$>), (<*>), (<*), (<*), (<|>))

import Data.Char (Char)
import Data.Foldable (asum)

import Text.Parser.Char (CharParsing, char,alphaNum)
import Text.Parser.Combinators (try,many)

import Data.Separated (Separated1,Separated, separatedBy1, separatedBy)

data Comma = Comma
  deriving Show

data Whitespace
  = Space
  | NewLine
  deriving Show

newtype WS = WS [Whitespace]
  deriving Show

parseWhitespace
  :: CharParsing f
  => f WS
parseWhitespace =
  WS <$> many (asum [ Space <$ char ' ' , NewLine <$ char '\n'])

parseComma
  :: CharParsing f
  => f Comma
parseComma =
  Comma <$ char ','

data Seppy =
  Seppy WS (Either (Separated1 (Char,WS) (Comma,WS)) (Separated (Char,WS) (Comma,WS)))
  deriving Show

-- |
-- >>> testparse parseSeppy "[]"
-- Right (Seppy (WS []) (Right []))
--
-- >>> testparse parseSeppy "[ ]"
-- Right (Seppy (WS [Space]) (Right []))
--
-- >>> testparse parseSeppy "[d , ]"
-- Right (Seppy (WS []) (Right [('d',WS [Space]),(Comma,WS [Space])]))
--
-- >>> isLeft $ testparse parseSeppy "[ , ]"
-- True
--
-- >>> isLeft $ testparse parseSeppy "[ , d]"
-- True
--
-- >>> isLeft $ testparse parseSeppy "[a d]"
-- True
--
-- >>> testparse parseSeppy "[\na\n , b]"
-- Right (Seppy (WS [NewLine]) (Left [('a',WS [NewLine,Space]),(Comma,WS [Space]),('b',WS [])]))
--
-- >>> testparse parseSeppy "[\na\n , b\n, ]"
-- Right (Seppy (WS [NewLine]) (Right [('a',WS [NewLine,Space]),(Comma,WS [Space]),('b',WS [NewLine]),(Comma,WS [Space])]))
--
-- >>> testparse parseSeppy "[a,b,c]"
-- Right (Seppy (WS []) (Left [('a',WS []),(Comma,WS []),('b',WS []),(Comma,WS []),('c',WS [])]))
--
-- >>> testparse parseSeppy "[a,b,c,]"
-- Right (Seppy (WS []) (Right [('a',WS []),(Comma,WS []),('b',WS []),(Comma,WS []),('c',WS []),(Comma,WS [])]))
parseSeppy
  :: CharParsing f
  => f Seppy
parseSeppy =
  let
    wWS p = liftA2 (,) p parseWhitespace

    a = Left <$> separatedBy1 (wWS alphaNum) (wWS parseComma)
    b = Right <$> separatedBy (wWS alphaNum) (wWS parseComma)
  in
    char '[' *> (Seppy <$> parseWhitespace <*> (try a <|> b)) <* char ']'