module Data.Spreadsheet (
   T,
   -- * parsing
   fromString,
   fromStringWithRemainder,
   fromStringSimple,
   Parser.UserMessage,
   -- * formatting
   toString,
   toStringSimple,
   ) where

import Data.List.HT  (chop, switchR, )
import Data.List     (intersperse, )
import Data.Maybe.HT (toMaybe, )

import qualified Data.Spreadsheet.Parser as Parser
import Control.Monad.Trans.State (runState, )
import Control.Monad (liftM, mplus, )

import qualified Control.Monad.Exception.Asynchronous as Async
import qualified Data.Spreadsheet.CharSource as CharSource

{- $setup
>>> import qualified Data.Spreadsheet as Spreadsheet
>>> import qualified Control.Monad.Exception.Asynchronous.Lazy as MEA
>>> import qualified Test.QuickCheck as QC
-}


{- |
A spreadsheet is a list of lines,
each line consists of cells,
and each cell is a string.
Ideally, spreadsheets read from a CSV file
have lines with the same number of cells per line.
However, we cannot assert this,
and thus we parse the lines as they come in.
-}
type T = [[String]]

parseChar :: CharSource.C source =>
   Char -> Parser.Fallible source Char
parseChar :: forall (source :: (* -> *) -> * -> *).
C source =>
Char -> Fallible source Char
parseChar Char
qm =
   Fallible source Char
-> Fallible source Char -> Fallible source Char
forall (source :: (* -> *) -> * -> *) a.
C source =>
Fallible source a -> Fallible source a -> Fallible source a
Parser.eitherOr
      ((Char -> Bool) -> Fallible source Char
forall (source :: (* -> *) -> * -> *).
C source =>
(Char -> Bool) -> Fallible source Char
Parser.satisfy (Char
qmChar -> Char -> Bool
forall a. Eq a => a -> a -> Bool
/=))
      (String -> Fallible source ()
forall (source :: (* -> *) -> * -> *).
C source =>
String -> Fallible source ()
Parser.string [Char
qm,Char
qm] Fallible source () -> Fallible source Char -> Fallible source Char
forall a b. source Maybe a -> source Maybe b -> source Maybe b
forall (m :: * -> *) a b. Monad m => m a -> m b -> m b
>> Char -> Fallible source Char
forall a. a -> source Maybe a
forall (m :: * -> *) a. Monad m => a -> m a
return Char
qm)

parseQuoted :: CharSource.C source =>
   Char -> Parser.PartialFallible source String
parseQuoted :: forall (source :: (* -> *) -> * -> *).
C source =>
Char -> PartialFallible source String
parseQuoted Char
qm =
   String
-> Fallible source ()
-> Fallible source ()
-> Partial source String
-> PartialFallible source String
forall (source :: (* -> *) -> * -> *) open close a.
C source =>
String
-> Fallible source open
-> Fallible source close
-> Partial source a
-> PartialFallible source a
Parser.between String
"missing closing quote"
      (Char -> Fallible source ()
forall (source :: (* -> *) -> * -> *).
C source =>
Char -> Fallible source ()
Parser.char Char
qm) (Char -> Fallible source ()
forall (source :: (* -> *) -> * -> *).
C source =>
Char -> Fallible source ()
Parser.char Char
qm)
      ((String -> PossiblyIncomplete String)
-> source Identity String -> Partial source String
forall (m :: * -> *) a1 r. Monad m => (a1 -> r) -> m a1 -> m r
liftM String -> PossiblyIncomplete String
forall a e. a -> Exceptional e a
Async.pure (source Identity String -> Partial source String)
-> source Identity String -> Partial source String
forall a b. (a -> b) -> a -> b
$ Fallible source Char -> source Identity String
forall (source :: (* -> *) -> * -> *) a.
C source =>
Fallible source a -> Straight source [a]
Parser.many (Char -> Fallible source Char
forall (source :: (* -> *) -> * -> *).
C source =>
Char -> Fallible source Char
parseChar Char
qm))

parseUnquoted :: CharSource.C source =>
   Char -> Char -> Parser.Straight source String
parseUnquoted :: forall (source :: (* -> *) -> * -> *).
C source =>
Char -> Char -> Straight source String
parseUnquoted Char
qm Char
sep =
   Fallible source Char -> Straight source String
forall (source :: (* -> *) -> * -> *) a.
C source =>
Fallible source a -> Straight source [a]
Parser.many
      ((Char -> Bool) -> Fallible source Char
forall (source :: (* -> *) -> * -> *).
C source =>
(Char -> Bool) -> Fallible source Char
Parser.satisfy (Bool -> Bool
not (Bool -> Bool) -> (Char -> Bool) -> Char -> Bool
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (Char -> String -> Bool) -> String -> Char -> Bool
forall a b c. (a -> b -> c) -> b -> a -> c
flip Char -> String -> Bool
forall a. Eq a => a -> [a] -> Bool
forall (t :: * -> *) a. (Foldable t, Eq a) => a -> t a -> Bool
elem [Char
qm,Char
sep,Char
'\r',Char
'\n']))

parseCell :: CharSource.C source =>
   Char -> Char -> Parser.Partial source String
parseCell :: forall (source :: (* -> *) -> * -> *).
C source =>
Char -> Char -> Partial source String
parseCell Char
qm Char
sep =
   Straight source (PossiblyIncomplete String)
-> Fallible source (PossiblyIncomplete String)
-> Straight source (PossiblyIncomplete String)
forall (source :: (* -> *) -> * -> *) a.
C source =>
Straight source a -> Fallible source a -> Straight source a
Parser.deflt ((String -> PossiblyIncomplete String)
-> source Identity String
-> Straight source (PossiblyIncomplete String)
forall (m :: * -> *) a1 r. Monad m => (a1 -> r) -> m a1 -> m r
liftM String -> PossiblyIncomplete String
forall a e. a -> Exceptional e a
Async.pure (source Identity String
 -> Straight source (PossiblyIncomplete String))
-> source Identity String
-> Straight source (PossiblyIncomplete String)
forall a b. (a -> b) -> a -> b
$ Char -> Char -> source Identity String
forall (source :: (* -> *) -> * -> *).
C source =>
Char -> Char -> Straight source String
parseUnquoted Char
qm Char
sep) (Char -> Fallible source (PossiblyIncomplete String)
forall (source :: (* -> *) -> * -> *).
C source =>
Char -> PartialFallible source String
parseQuoted Char
qm)

parseLine :: CharSource.C source =>
   Char -> Char -> Parser.Partial source [String]
parseLine :: forall (source :: (* -> *) -> * -> *).
C source =>
Char -> Char -> Partial source [String]
parseLine Char
qm Char
sep =
   Fallible source ()
-> PartialFallible source String -> Partial source [String]
forall (source :: (* -> *) -> * -> *) sep a.
C source =>
Fallible source sep
-> PartialFallible source a -> Partial source [a]
Parser.sepByIncomplete (Char -> Fallible source ()
forall (source :: (* -> *) -> * -> *).
C source =>
Char -> Fallible source ()
Parser.char Char
sep) (source Identity (PossiblyIncomplete String)
-> PartialFallible source String
forall a. source Identity a -> source Maybe a
forall (m :: (* -> *) -> * -> *) a.
C m =>
m Identity a -> m Maybe a
CharSource.fallible (source Identity (PossiblyIncomplete String)
 -> PartialFallible source String)
-> source Identity (PossiblyIncomplete String)
-> PartialFallible source String
forall a b. (a -> b) -> a -> b
$ Char -> Char -> source Identity (PossiblyIncomplete String)
forall (source :: (* -> *) -> * -> *).
C source =>
Char -> Char -> Partial source String
parseCell Char
qm Char
sep)

parseLineEnd :: CharSource.C source =>
   Parser.Fallible source ()
parseLineEnd :: forall (source :: (* -> *) -> * -> *).
C source =>
Fallible source ()
parseLineEnd =
   (Char -> Fallible source ()
forall (source :: (* -> *) -> * -> *).
C source =>
Char -> Fallible source ()
Parser.char Char
'\r' Fallible source () -> Fallible source () -> Fallible source ()
forall a b. source Maybe a -> source Maybe b -> source Maybe b
forall (m :: * -> *) a b. Monad m => m a -> m b -> m b
>> (Char -> Fallible source ()
forall (source :: (* -> *) -> * -> *).
C source =>
Char -> Fallible source ()
Parser.char Char
'\n' Fallible source () -> Fallible source () -> Fallible source ()
forall (source :: (* -> *) -> * -> *) a.
C source =>
Fallible source a -> Fallible source a -> Fallible source a
`Parser.eitherOr` () -> Fallible source ()
forall a. a -> source Maybe a
forall (m :: * -> *) a. Monad m => a -> m a
return ()))
   Fallible source () -> Fallible source () -> Fallible source ()
forall (source :: (* -> *) -> * -> *) a.
C source =>
Fallible source a -> Fallible source a -> Fallible source a
`Parser.eitherOr`
   Char -> Fallible source ()
forall (source :: (* -> *) -> * -> *).
C source =>
Char -> Fallible source ()
Parser.char Char
'\n'

parseLineWithEnd :: CharSource.C source =>
   Char -> Char -> Parser.Partial source [String]
parseLineWithEnd :: forall (source :: (* -> *) -> * -> *).
C source =>
Char -> Char -> Partial source [String]
parseLineWithEnd Char
qm Char
sep =
   String
-> Fallible source ()
-> Partial source [String]
-> Partial source [String]
forall (source :: (* -> *) -> * -> *) close a.
C source =>
String
-> Fallible source close -> Partial source a -> Partial source a
Parser.terminated String
"line end expected" Fallible source ()
forall (source :: (* -> *) -> * -> *).
C source =>
Fallible source ()
parseLineEnd (Partial source [String] -> Partial source [String])
-> Partial source [String] -> Partial source [String]
forall a b. (a -> b) -> a -> b
$
   Char -> Char -> Partial source [String]
forall (source :: (* -> *) -> * -> *).
C source =>
Char -> Char -> Partial source [String]
parseLine Char
qm Char
sep


parseTable :: CharSource.C source =>
   Char -> Char -> Parser.Partial source [[String]]
parseTable :: forall (source :: (* -> *) -> * -> *).
C source =>
Char -> Char -> Partial source [[String]]
parseTable Char
qm Char
sep =
   PartialFallible source [String] -> Partial source [[String]]
forall (source :: (* -> *) -> * -> *) a.
C source =>
PartialFallible source a -> Partial source [a]
Parser.manyIncomplete (PartialFallible source [String] -> Partial source [[String]])
-> PartialFallible source [String] -> Partial source [[String]]
forall a b. (a -> b) -> a -> b
$
{-
   CharSource.fallible $ parseLineWithEnd qm sep
-}
   source Identity Bool -> source Maybe Bool
forall a. source Identity a -> source Maybe a
forall (m :: (* -> *) -> * -> *) a.
C m =>
m Identity a -> m Maybe a
CharSource.fallible source Identity Bool
forall (m :: (* -> *) -> * -> *). C m => m Identity Bool
CharSource.isEnd source Maybe Bool
-> (Bool -> PartialFallible source [String])
-> PartialFallible source [String]
forall a b.
source Maybe a -> (a -> source Maybe b) -> source Maybe b
forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>= \Bool
b ->
   if Bool
b then PartialFallible source [String]
forall a. source Maybe a
forall (m :: (* -> *) -> * -> *) a. C m => m Maybe a
CharSource.stop else source Identity (PossiblyIncomplete [String])
-> PartialFallible source [String]
forall a. source Identity a -> source Maybe a
forall (m :: (* -> *) -> * -> *) a.
C m =>
m Identity a -> m Maybe a
CharSource.fallible (source Identity (PossiblyIncomplete [String])
 -> PartialFallible source [String])
-> source Identity (PossiblyIncomplete [String])
-> PartialFallible source [String]
forall a b. (a -> b) -> a -> b
$ Char -> Char -> source Identity (PossiblyIncomplete [String])
forall (source :: (* -> *) -> * -> *).
C source =>
Char -> Char -> Partial source [String]
parseLineWithEnd Char
qm Char
sep

{- |
@fromString qm sep text@ parses @text@ into a spreadsheet,
using the quotation character @qm@ and the separator character @sep@.

>>> Spreadsheet.fromString '"' '\t' "\"hello\"\t\"world\"\n\"end\"\n"
Exceptional {exception = Nothing, result = [["hello","world"],["end"]]}
>>> Spreadsheet.fromString '"' ',' "\"hello,world\",\"really\"\n\"end\"\n"
Exceptional {exception = Nothing, result = [["hello,world","really"],["end"]]}
>>> Spreadsheet.fromString '"' ';' "\"hello \"\"world\"\"\"\n\"really\"\n"
Exceptional {exception = Nothing, result = [["hello \"world\""],["really"]]}
>>> Spreadsheet.fromString '"' ',' "\"hello\nworld\"\n"
Exceptional {exception = Nothing, result = [["hello\nworld"]]}
-}
fromString :: Char -> Char -> String -> Async.Exceptional Parser.UserMessage T
fromString :: Char -> Char -> String -> Exceptional String [[String]]
fromString Char
qm Char
sep String
str =
   let (Async.Exceptional Maybe String
e ([[String]]
table, String
rest)) =
          Char -> Char -> String -> Exceptional String ([[String]], String)
fromStringWithRemainder Char
qm Char
sep String
str
   in  Maybe String -> [[String]] -> Exceptional String [[String]]
forall e a. Maybe e -> a -> Exceptional e a
Async.Exceptional
          (Maybe String -> Maybe String -> Maybe String
forall a. Maybe a -> Maybe a -> Maybe a
forall (m :: * -> *) a. MonadPlus m => m a -> m a -> m a
mplus Maybe String
e (Bool -> String -> Maybe String
forall a. Bool -> a -> Maybe a
toMaybe (Bool -> Bool
not (String -> Bool
forall a. [a] -> Bool
forall (t :: * -> *) a. Foldable t => t a -> Bool
null String
rest)) String
"junk after table")) [[String]]
table

{- |
@fromString qm sep text@ parses @text@ into a spreadsheet
and additionally returns text that follows after CSV formatted data.
-}
fromStringWithRemainder ::
   Char -> Char -> String -> Async.Exceptional Parser.UserMessage (T, String)
fromStringWithRemainder :: Char -> Char -> String -> Exceptional String ([[String]], String)
fromStringWithRemainder Char
qm Char
sep String
str =
   let (~(Async.Exceptional Maybe String
e [[String]]
table), String
rest) =
          State String (Exceptional String [[String]])
-> String -> (Exceptional String [[String]], String)
forall s a. State s a -> s -> (a, s)
runState (String Identity (Exceptional String [[String]])
-> State String (Exceptional String [[String]])
forall (fail :: * -> *) a. String fail a -> StateT String fail a
CharSource.runString (Char -> Char -> String Identity (Exceptional String [[String]])
forall (source :: (* -> *) -> * -> *).
C source =>
Char -> Char -> Partial source [[String]]
parseTable Char
qm Char
sep)) String
str
   in  Maybe String
-> ([[String]], String) -> Exceptional String ([[String]], String)
forall e a. Maybe e -> a -> Exceptional e a
Async.Exceptional Maybe String
e ([[String]]
table, String
rest)


{- |
>>> Spreadsheet.toString '"' '\t' [["hello","world"],["end"]]
"\"hello\"\t\"world\"\n\"end\"\n"
>>> Spreadsheet.toString '"' ',' [["hello,world","really"],["end"]]
"\"hello,world\",\"really\"\n\"end\"\n"
>>> Spreadsheet.toString '"' ';' [["hello \"world\""],["really"]]
"\"hello \"\"world\"\"\"\n\"really\"\n"
>>> Spreadsheet.toString '"' ',' [["hello\nworld"]]
"\"hello\nworld\"\n"
>>> take 50 $ Spreadsheet.toString '"' ',' $ repeat ["hello","world"]
"\"hello\",\"world\"\n\"hello\",\"world\"\n\"hello\",\"world\"\n\"h"
>>> take 50 $ Spreadsheet.toString '"' ',' [cycle ["hello","world"]]
"\"hello\",\"world\",\"hello\",\"world\",\"hello\",\"world\",\"h"

prop> :{
   QC.forAll (QC.elements ";,\t ") $ \sep tableNE ->
   let table = map QC.getNonEmpty tableNE in
   table ==
   MEA.result (Spreadsheet.fromString '"' sep
                  (Spreadsheet.toString '"' sep table))
:}
-}
toString :: Char -> Char -> T -> String
toString :: Char -> Char -> [[String]] -> String
toString Char
qm Char
sep =
   [String] -> String
unlines ([String] -> String)
-> ([[String]] -> [String]) -> [[String]] -> String
forall b c a. (b -> c) -> (a -> b) -> a -> c
. ([String] -> String) -> [[String]] -> [String]
forall a b. (a -> b) -> [a] -> [b]
map ([String] -> String
forall (t :: * -> *) a. Foldable t => t [a] -> [a]
concat ([String] -> String)
-> ([String] -> [String]) -> [String] -> String
forall b c a. (b -> c) -> (a -> b) -> a -> c
. String -> [String] -> [String]
forall a. a -> [a] -> [a]
intersperse [Char
sep] ([String] -> [String])
-> ([String] -> [String]) -> [String] -> [String]
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (String -> String) -> [String] -> [String]
forall a b. (a -> b) -> [a] -> [b]
map (Char -> String -> String
quote Char
qm))

quote :: Char -> String -> String
quote :: Char -> String -> String
quote Char
qm String
s = Char
qm Char -> String -> String
forall a. a -> [a] -> [a]
: (Char -> String -> String) -> String -> String -> String
forall a b. (a -> b -> b) -> b -> [a] -> b
forall (t :: * -> *) a b.
Foldable t =>
(a -> b -> b) -> b -> t a -> b
foldr (\Char
c String
cs -> Char
c Char -> String -> String
forall a. a -> [a] -> [a]
: if Char
cChar -> Char -> Bool
forall a. Eq a => a -> a -> Bool
==Char
qm then Char
qmChar -> String -> String
forall a. a -> [a] -> [a]
:String
cs else String
cs) [Char
qm] String
s
-- quote qm s = [qm] ++ replace [qm] [qm,qm] s ++ [qm]


{- |
This is a quick hack.
It does neither handle field nor line separators within quoted fields.
You must provide well-formed CSV content
without field and line separators within quotations.
Everything else yields an error.
-}
fromStringSimple :: Char -> Char -> String -> T
fromStringSimple :: Char -> Char -> String -> [[String]]
fromStringSimple Char
qm Char
sep =
   (String -> [String]) -> [String] -> [[String]]
forall a b. (a -> b) -> [a] -> [b]
map ((String -> String) -> [String] -> [String]
forall a b. (a -> b) -> [a] -> [b]
map (Char -> String -> String
forall a. Eq a => a -> [a] -> [a]
dequoteSimpleOptional Char
qm) ([String] -> [String])
-> (String -> [String]) -> String -> [String]
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (Char -> Bool) -> String -> [String]
forall a. (a -> Bool) -> [a] -> [[a]]
chop (Char
sepChar -> Char -> Bool
forall a. Eq a => a -> a -> Bool
==)) ([String] -> [[String]])
-> (String -> [String]) -> String -> [[String]]
forall b c a. (b -> c) -> (a -> b) -> a -> c
. String -> [String]
lines

toStringSimple :: Char -> Char -> T -> String
toStringSimple :: Char -> Char -> [[String]] -> String
toStringSimple Char
qm Char
sep =
   [String] -> String
unlines ([String] -> String)
-> ([[String]] -> [String]) -> [[String]] -> String
forall b c a. (b -> c) -> (a -> b) -> a -> c
. ([String] -> String) -> [[String]] -> [String]
forall a b. (a -> b) -> [a] -> [b]
map ([String] -> String
forall (t :: * -> *) a. Foldable t => t [a] -> [a]
concat ([String] -> String)
-> ([String] -> [String]) -> [String] -> String
forall b c a. (b -> c) -> (a -> b) -> a -> c
. String -> [String] -> [String]
forall a. a -> [a] -> [a]
intersperse [Char
sep] ([String] -> [String])
-> ([String] -> [String]) -> [String] -> [String]
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (String -> String) -> [String] -> [String]
forall a b. (a -> b) -> [a] -> [b]
map (\String
s -> [Char
qm]String -> String -> String
forall a. [a] -> [a] -> [a]
++String
sString -> String -> String
forall a. [a] -> [a] -> [a]
++[Char
qm]))

_dequoteSimple :: Eq a => a -> [a] -> [a]
_dequoteSimple :: forall a. Eq a => a -> [a] -> [a]
_dequoteSimple a
_ [] = String -> [a]
forall a. HasCallStack => String -> a
error String
"dequoteSimple: string is empty"
_dequoteSimple a
qm (a
x:[a]
xs) =
   if a
x a -> a -> Bool
forall a. Eq a => a -> a -> Bool
/= a
qm
     then String -> [a]
forall a. HasCallStack => String -> a
error String
"dequoteSimple: quotation mark missing at beginning"
     else
       [a] -> ([a] -> a -> [a]) -> [a] -> [a]
forall b a. b -> ([a] -> a -> b) -> [a] -> b
switchR
         (String -> [a]
forall a. HasCallStack => String -> a
error String
"dequoteSimple: string consists only of a single quotation mark")
         (\[a]
ys a
y ->
            [a]
ys [a] -> [a] -> [a]
forall a. [a] -> [a] -> [a]
++
            if a
y a -> a -> Bool
forall a. Eq a => a -> a -> Bool
== a
qm
              then []
              else String -> [a]
forall a. HasCallStack => String -> a
error String
"dequoteSimple: string does not end with a quotation mark")
         [a]
xs

dequoteSimpleOptional :: Eq a => a -> [a] -> [a]
dequoteSimpleOptional :: forall a. Eq a => a -> [a] -> [a]
dequoteSimpleOptional a
_ [] = []
dequoteSimpleOptional a
qm xt :: [a]
xt@(a
x:[a]
xs) =
   if a
x a -> a -> Bool
forall a. Eq a => a -> a -> Bool
/= a
qm
     then a -> [a] -> [a]
forall a. Eq a => a -> [a] -> [a]
unescapeQuoteSimple a
qm [a]
xt
     else
       [a] -> ([a] -> a -> [a]) -> [a] -> [a]
forall b a. b -> ([a] -> a -> b) -> [a] -> b
switchR
         (String -> [a]
forall a. HasCallStack => String -> a
error String
"dequoteSimpleOptional: string consists only of a single quotation mark")
         (\[a]
ys a
y ->
            a -> [a] -> [a]
forall a. Eq a => a -> [a] -> [a]
unescapeQuoteSimple a
qm [a]
ys [a] -> [a] -> [a]
forall a. [a] -> [a] -> [a]
++
            if a
y a -> a -> Bool
forall a. Eq a => a -> a -> Bool
== a
qm
              then []
              else String -> [a]
forall a. HasCallStack => String -> a
error String
"dequoteSimpleOptional: string does not end with a quotation mark")
         [a]
xs

unescapeQuoteSimple :: Eq a => a -> [a] -> [a]
unescapeQuoteSimple :: forall a. Eq a => a -> [a] -> [a]
unescapeQuoteSimple a
qm =
   let recourse :: [a] -> [a]
recourse [] = []
       recourse (a
x:[a]
xs) =
          if a
x a -> a -> Bool
forall a. Eq a => a -> a -> Bool
/= a
qm
            then a
x a -> [a] -> [a]
forall a. a -> [a] -> [a]
: [a] -> [a]
recourse [a]
xs
            else case [a]
xs of
                    [] -> String -> [a]
forall a. HasCallStack => String -> a
error String
"unescapeQuoteSimple: single quotation mark at end of string"
                    a
y:[a]
ys ->
                       if a
ya -> a -> Bool
forall a. Eq a => a -> a -> Bool
/=a
qm
                         then String -> [a]
forall a. HasCallStack => String -> a
error String
"unescapeQuoteSimple: unmatched quotation mark"
                         else a
qm a -> [a] -> [a]
forall a. a -> [a] -> [a]
: [a] -> [a]
recourse [a]
ys
   in  [a] -> [a]
recourse