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


{- |
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 =
   forall (source :: (* -> *) -> * -> *) a.
C source =>
Fallible source a -> Fallible source a -> Fallible source a
Parser.eitherOr
      (forall (source :: (* -> *) -> * -> *).
C source =>
(Char -> Bool) -> Fallible source Char
Parser.satisfy (Char
qmforall a. Eq a => a -> a -> Bool
/=))
      (forall (source :: (* -> *) -> * -> *).
C source =>
String -> Fallible source ()
Parser.string [Char
qm,Char
qm] forall (m :: * -> *) a b. Monad m => m a -> m b -> m b
>> 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 =
   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"
      (forall (source :: (* -> *) -> * -> *).
C source =>
Char -> Fallible source ()
Parser.char Char
qm) (forall (source :: (* -> *) -> * -> *).
C source =>
Char -> Fallible source ()
Parser.char Char
qm)
      (forall (m :: * -> *) a1 r. Monad m => (a1 -> r) -> m a1 -> m r
liftM forall a e. a -> Exceptional e a
Async.pure forall a b. (a -> b) -> a -> b
$ forall (source :: (* -> *) -> * -> *) a.
C source =>
Fallible source a -> Straight source [a]
Parser.many (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 =
   forall (source :: (* -> *) -> * -> *) a.
C source =>
Fallible source a -> Straight source [a]
Parser.many
      (forall (source :: (* -> *) -> * -> *).
C source =>
(Char -> Bool) -> Fallible source Char
Parser.satisfy (Bool -> Bool
not forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall a b c. (a -> b -> c) -> b -> a -> c
flip 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 =
   forall (source :: (* -> *) -> * -> *) a.
C source =>
Straight source a -> Fallible source a -> Straight source a
Parser.deflt (forall (m :: * -> *) a1 r. Monad m => (a1 -> r) -> m a1 -> m r
liftM forall a e. a -> Exceptional e a
Async.pure forall a b. (a -> b) -> a -> b
$ forall (source :: (* -> *) -> * -> *).
C source =>
Char -> Char -> Straight source String
parseUnquoted Char
qm Char
sep) (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 =
   forall (source :: (* -> *) -> * -> *) sep a.
C source =>
Fallible source sep
-> PartialFallible source a -> Partial source [a]
Parser.sepByIncomplete (forall (source :: (* -> *) -> * -> *).
C source =>
Char -> Fallible source ()
Parser.char Char
sep) (forall (m :: (* -> *) -> * -> *) a.
C m =>
m Identity a -> m Maybe a
CharSource.fallible forall a b. (a -> b) -> a -> b
$ 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 =
   (forall (source :: (* -> *) -> * -> *).
C source =>
Char -> Fallible source ()
Parser.char Char
'\r' forall (m :: * -> *) a b. Monad m => m a -> m b -> m b
>> (forall (source :: (* -> *) -> * -> *).
C source =>
Char -> Fallible source ()
Parser.char Char
'\n' forall (source :: (* -> *) -> * -> *) a.
C source =>
Fallible source a -> Fallible source a -> Fallible source a
`Parser.eitherOr` forall (m :: * -> *) a. Monad m => a -> m a
return ()))
   forall (source :: (* -> *) -> * -> *) a.
C source =>
Fallible source a -> Fallible source a -> Fallible source a
`Parser.eitherOr`
   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 =
   forall (source :: (* -> *) -> * -> *) close a.
C source =>
String
-> Fallible source close -> Partial source a -> Partial source a
Parser.terminated String
"line end expected" forall (source :: (* -> *) -> * -> *).
C source =>
Fallible source ()
parseLineEnd forall a b. (a -> b) -> a -> b
$
   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 =
   forall (source :: (* -> *) -> * -> *) a.
C source =>
PartialFallible source a -> Partial source [a]
Parser.manyIncomplete forall a b. (a -> b) -> a -> b
$
{-
   CharSource.fallible $ parseLineWithEnd qm sep
-}
   forall (m :: (* -> *) -> * -> *) a.
C m =>
m Identity a -> m Maybe a
CharSource.fallible forall (m :: (* -> *) -> * -> *). C m => m Identity Bool
CharSource.isEnd forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>= \Bool
b ->
   if Bool
b then forall (m :: (* -> *) -> * -> *) a. C m => m Maybe a
CharSource.stop else forall (m :: (* -> *) -> * -> *) a.
C m =>
m Identity a -> m Maybe a
CharSource.fallible forall a b. (a -> b) -> a -> b
$ 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@.
-}
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  forall e a. Maybe e -> a -> Exceptional e a
Async.Exceptional
          (forall (m :: * -> *) a. MonadPlus m => m a -> m a -> m a
mplus Maybe String
e (forall a. Bool -> a -> Maybe a
toMaybe (Bool -> Bool
not (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) =
          forall s a. State s a -> s -> (a, s)
runState (forall (fail :: * -> *) a. String fail a -> StateT String fail a
CharSource.runString (forall (source :: (* -> *) -> * -> *).
C source =>
Char -> Char -> Partial source [[String]]
parseTable Char
qm Char
sep)) String
str
   in  forall e a. Maybe e -> a -> Exceptional e a
Async.Exceptional Maybe String
e ([[String]]
table, String
rest)


toString :: Char -> Char -> T -> String
toString :: Char -> Char -> [[String]] -> String
toString Char
qm Char
sep =
   [String] -> String
unlines forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall a b. (a -> b) -> [a] -> [b]
map (forall (t :: * -> *) a. Foldable t => t [a] -> [a]
concat forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall a. a -> [a] -> [a]
intersperse [Char
sep] forall b c a. (b -> c) -> (a -> b) -> a -> c
. 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 forall a. a -> [a] -> [a]
: forall (t :: * -> *) a b.
Foldable t =>
(a -> b -> b) -> b -> t a -> b
foldr (\Char
c String
cs -> Char
c forall a. a -> [a] -> [a]
: if Char
cforall a. Eq a => a -> a -> Bool
==Char
qm then Char
qmforall 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 =
   forall a b. (a -> b) -> [a] -> [b]
map (forall a b. (a -> b) -> [a] -> [b]
map (forall a. Eq a => a -> [a] -> [a]
dequoteSimpleOptional Char
qm) forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall a. (a -> Bool) -> [a] -> [[a]]
chop (Char
sepforall a. Eq a => a -> a -> Bool
==)) 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 forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall a b. (a -> b) -> [a] -> [b]
map (forall (t :: * -> *) a. Foldable t => t [a] -> [a]
concat forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall a. a -> [a] -> [a]
intersperse [Char
sep] forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall a b. (a -> b) -> [a] -> [b]
map (\String
s -> [Char
qm]forall a. [a] -> [a] -> [a]
++String
sforall a. [a] -> [a] -> [a]
++[Char
qm]))

_dequoteSimple :: Eq a => a -> [a] -> [a]
_dequoteSimple :: forall a. Eq a => a -> [a] -> [a]
_dequoteSimple a
_ [] = forall a. HasCallStack => String -> a
error String
"dequoteSimple: string is empty"
_dequoteSimple a
qm (a
x:[a]
xs) =
   if a
x forall a. Eq a => a -> a -> Bool
/= a
qm
     then forall a. HasCallStack => String -> a
error String
"dequoteSimple: quotation mark missing at beginning"
     else
       forall b a. b -> ([a] -> a -> b) -> [a] -> b
switchR
         (forall a. HasCallStack => String -> a
error String
"dequoteSimple: string consists only of a single quotation mark")
         (\[a]
ys a
y ->
            [a]
ys forall a. [a] -> [a] -> [a]
++
            if a
y forall a. Eq a => a -> a -> Bool
== a
qm
              then []
              else 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 forall a. Eq a => a -> a -> Bool
/= a
qm
     then forall a. Eq a => a -> [a] -> [a]
unescapeQuoteSimple a
qm [a]
xt
     else
       forall b a. b -> ([a] -> a -> b) -> [a] -> b
switchR
         (forall a. HasCallStack => String -> a
error String
"dequoteSimpleOptional: string consists only of a single quotation mark")
         (\[a]
ys a
y ->
            forall a. Eq a => a -> [a] -> [a]
unescapeQuoteSimple a
qm [a]
ys forall a. [a] -> [a] -> [a]
++
            if a
y forall a. Eq a => a -> a -> Bool
== a
qm
              then []
              else 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 forall a. Eq a => a -> a -> Bool
/= a
qm
            then a
x forall a. a -> [a] -> [a]
: [a] -> [a]
recourse [a]
xs
            else case [a]
xs of
                    [] -> forall a. HasCallStack => String -> a
error String
"unescapeQuoteSimple: single quotation mark at end of string"
                    a
y:[a]
ys ->
                       if a
yforall a. Eq a => a -> a -> Bool
/=a
qm
                         then forall a. HasCallStack => String -> a
error String
"unescapeQuoteSimple: unmatched quotation mark"
                         else a
qm forall a. a -> [a] -> [a]
: [a] -> [a]
recourse [a]
ys
   in  [a] -> [a]
recourse