diff --git a/LICENSE b/LICENSE new file mode 100644 --- /dev/null +++ b/LICENSE @@ -0,0 +1,31 @@ +Copyright (c) 2009, Henning Thielemann + +All rights reserved. + +Redistribution and use in source and binary forms, with or without +modification, are permitted provided that the following conditions are +met: + + * Redistributions of source code must retain the above copyright + notice, this list of conditions and the following disclaimer. + + * Redistributions in binary form must reproduce the above + copyright notice, this list of conditions and the following + disclaimer in the documentation and/or other materials provided + with the distribution. + + * The names of contributors may not be used to endorse or promote + products derived from this software without specific prior + written permission. + +THIS SOFTWARE IS PROVIDED BY THE COPYRIGHT HOLDERS AND CONTRIBUTORS +"AS IS" AND ANY EXPRESS OR IMPLIED WARRANTIES, INCLUDING, BUT NOT +LIMITED TO, THE IMPLIED WARRANTIES OF MERCHANTABILITY AND FITNESS FOR +A PARTICULAR PURPOSE ARE DISCLAIMED. IN NO EVENT SHALL THE COPYRIGHT +OWNER OR CONTRIBUTORS BE LIABLE FOR ANY DIRECT, INDIRECT, INCIDENTAL, +SPECIAL, EXEMPLARY, OR CONSEQUENTIAL DAMAGES (INCLUDING, BUT NOT +LIMITED TO, PROCUREMENT OF SUBSTITUTE GOODS OR SERVICES; LOSS OF USE, +DATA, OR PROFITS; OR BUSINESS INTERRUPTION) HOWEVER CAUSED AND ON ANY +THEORY OF LIABILITY, WHETHER IN CONTRACT, STRICT LIABILITY, OR TORT +(INCLUDING NEGLIGENCE OR OTHERWISE) ARISING IN ANY WAY OUT OF THE USE +OF THIS SOFTWARE, EVEN IF ADVISED OF THE POSSIBILITY OF SUCH DAMAGE. diff --git a/Setup.lhs b/Setup.lhs new file mode 100644 --- /dev/null +++ b/Setup.lhs @@ -0,0 +1,3 @@ +#! /usr/bin/env runhaskell +> import Distribution.Simple +> main = defaultMain diff --git a/spreadsheet.cabal b/spreadsheet.cabal new file mode 100644 --- /dev/null +++ b/spreadsheet.cabal @@ -0,0 +1,53 @@ +Name: spreadsheet +Version: 0.1 +License: BSD3 +License-File: LICENSE +Author: Henning Thielemann +Maintainer: Henning Thielemann +Homepage: http://www.haskell.org/haskellwiki/Spreadsheet +Category: Data, Text +Synopsis: Read and write spreadsheets from and to CSV files in a lazy way +Description: + Read and write spreadsheets from and to CSV files in a lazy way. + See also the csv package on Hackage and + , + . + Both do not parse lazy. + Reading from other source than plain 'String's could be easily added. +Tested-With: GHC==6.8.2 +Cabal-Version: >=1.6 +Build-Type: Simple +Source-Repository head + type: darcs + location: http://code.haskell.org/~thielema/spreadsheet/ + +Source-Repository this + type: darcs + location: http://code.haskell.org/~thielema/spreadsheet/ + tag: 0.1 + +Flag splitBase + description: Choose the new smaller, split-up base package. + +Flag buildTests + description: Build test executables + default: False + +Library + Build-Depends: + utility-ht >=0.0.2 && <0.1, + transformers >=0.0 && <0.1, + explicit-exception >=0.1 && <0.2 + If flag(splitBase) + Build-Depends: base >= 2 + Else + Build-Depends: base >= 1.0 && < 2 + + GHC-Options: -Wall + Extensions: GeneralizedNewtypeDeriving + Hs-Source-Dirs: src + Exposed-Modules: + Data.Spreadsheet + Other-Modules: + Data.Spreadsheet.Parser + Data.Spreadsheet.CharSource diff --git a/src/Data/Spreadsheet.hs b/src/Data/Spreadsheet.hs new file mode 100644 --- /dev/null +++ b/src/Data/Spreadsheet.hs @@ -0,0 +1,129 @@ +module Data.Spreadsheet ( + T, + -- * parsing + fromString, + fromStringSimple, + -- * 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 qm = + Parser.eitherOr + (Parser.satisfy (qm/=)) + (Parser.string [qm,qm] >> return qm) + +parseQuoted :: CharSource.C source => + Char -> Parser.PartialFallible source String +parseQuoted qm = + Parser.between "missing closing quote" + (Parser.char qm) (Parser.char qm) + (liftM Async.pure $ Parser.many (parseChar qm)) + +parseUnquoted :: CharSource.C source => + Char -> Char -> Parser.Straight source String +parseUnquoted qm sep = + Parser.many + (Parser.satisfy (not . flip elem [qm,sep,'\r','\n'])) + +parseCell :: CharSource.C source => + Char -> Char -> Parser.Partial source String +parseCell qm sep = + Parser.deflt (liftM Async.pure $ parseUnquoted qm sep) (parseQuoted qm) + +parseLine :: CharSource.C source => + Char -> Char -> Parser.Partial source [String] +parseLine qm sep = + Parser.sepByIncomplete (Parser.char sep) (CharSource.fallible $ parseCell qm sep) + +parseLineEnd :: CharSource.C source => + Parser.Fallible source () +parseLineEnd = + (Parser.char '\r' >> (Parser.char '\n' `Parser.eitherOr` return ())) + `Parser.eitherOr` + Parser.char '\n' + +parseLineWithEnd :: CharSource.C source => + Char -> Char -> Parser.Partial source [String] +parseLineWithEnd qm sep = + Parser.terminated "line end expected" parseLineEnd $ + parseLine qm sep + + +parseTable :: CharSource.C source => + Char -> Char -> Parser.Partial source [[String]] +parseTable qm sep = + Parser.manyIncomplete $ +{- + CharSource.fallible $ parseLineWithEnd qm sep +-} + CharSource.fallible CharSource.isEnd >>= \b -> + if b then CharSource.stop else CharSource.fallible $ parseLineWithEnd qm 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 qm sep str = + let (~(Async.Exceptional e table), rest) = + runState (CharSource.runString (parseTable qm sep)) str + in Async.Exceptional + (mplus e (toMaybe (not (null rest)) "junk after table")) table + + +toString :: Char -> Char -> T -> String +toString qm sep = + unlines . map (concat . intersperse [sep] . map (quote qm)) + +quote :: Char -> String -> String +quote qm s = qm : foldr (\c cs -> c : if c==qm then qm:cs else cs) [qm] s +-- quote qm s = [qm] ++ replace [qm] [qm,qm] s ++ [qm] + + +fromStringSimple :: Char -> Char -> String -> T +fromStringSimple qm sep = + map (map (dequoteSimple qm) . chop (sep==)) . lines + +toStringSimple :: Char -> Char -> T -> String +toStringSimple qm sep = + unlines . map (concat . intersperse [sep] . map (\s -> [qm]++s++[qm])) + +dequoteSimple :: Eq a => a -> [a] -> [a] +dequoteSimple _ [] = error "dequoteSimple: string is empty" +dequoteSimple qm (x:xs) = + if x == qm + then error "dequoteSimple: quotation mark missing at beginning" + else + switchR + (error "dequoteSimple: string consists only of a single quotation mark") + (\ys y -> + if y == qm + then ys + else (error "dequoteSimple: string does not end with a quotation mark")) + xs diff --git a/src/Data/Spreadsheet/CharSource.hs b/src/Data/Spreadsheet/CharSource.hs new file mode 100644 --- /dev/null +++ b/src/Data/Spreadsheet/CharSource.hs @@ -0,0 +1,40 @@ +module Data.Spreadsheet.CharSource where + +import qualified Control.Monad.Trans.State as State +import Control.Monad.Trans.State (StateT(StateT), gets, runStateT, mapStateT, ) +import Control.Monad.Identity (Identity(Identity), runIdentity, ) + +import Data.List.HT (viewL, ) +import Data.Tuple.HT (forcePair, ) + +import qualified Prelude as P +import Prelude hiding (String) + + +class (Monad (m Maybe), Monad (m Identity)) => C m where + get :: m Maybe Char + isEnd :: m Identity Bool + stop :: m Maybe a + fallible :: m Identity a -> m Maybe a + {- | + Try to run a parser. + If it succeeds, return (Just value) and advance input position. + If it fails, return Nothing and keep the input position. + -} + try :: m Maybe a -> m Identity (Maybe a) + + +newtype String fail a = String {runString :: StateT P.String fail a} + deriving (Monad) + + +instance C String where + get = String $ StateT viewL + isEnd = String $ gets null + stop = String $ StateT $ const Nothing + fallible x = String $ mapStateT (Just . runIdentity) $ runString x + try x = String $ StateT $ \s0 -> + Identity $ forcePair $ + case runStateT (runString x) s0 of + Nothing -> (Nothing, s0) + Just (a,s1) -> (Just a, s1) diff --git a/src/Data/Spreadsheet/Parser.hs b/src/Data/Spreadsheet/Parser.hs new file mode 100644 --- /dev/null +++ b/src/Data/Spreadsheet/Parser.hs @@ -0,0 +1,110 @@ +module Data.Spreadsheet.Parser where + +import qualified Data.Spreadsheet.CharSource as CharSource + +import qualified Control.Monad.Exception.Asynchronous as Async + +import Control.Monad.Identity (Identity, ) +import Control.Monad (liftM, liftM2, ) + +import Data.Maybe (fromMaybe, ) + + +type T source a = source a + +type Straight source a = source Identity a +type Fallible source a = source Maybe a +type Partial source a = source Identity (PossiblyIncomplete a) +type PartialFallible source a = source Maybe (PossiblyIncomplete a) + +type PossiblyIncomplete a = Async.Exceptional UserMessage a + +type UserMessage = String + + +satisfy :: + (CharSource.C source) => + (Char -> Bool) -> Fallible source Char +satisfy p = + do c <- CharSource.get + if p c + then return c + else CharSource.stop + +char :: (CharSource.C source) => + Char -> Fallible source () +char c = satisfy (c==) >> return () + +string :: (CharSource.C source) => + String -> Fallible source () +string s = mapM_ char s + +many :: (CharSource.C source) => + Fallible source a -> Straight source [a] +many p = + let go = + liftM (fromMaybe []) $ + CharSource.try + (liftM2 (:) p (CharSource.fallible go)) + in go + +appendIncomplete :: + CharSource.C source => + PartialFallible source a -> + Partial source [a] -> + PartialFallible source [a] +appendIncomplete p ps = + do ~(Async.Exceptional me x) <- p + CharSource.fallible $ liftM (fmap (x:)) $ + maybe ps (\_ -> return (Async.Exceptional me [])) me + +absorbException :: + (CharSource.C source) => + PartialFallible source [a] -> + Partial source [a] +absorbException = + liftM (fromMaybe (Async.pure [])) . + CharSource.try + +manyIncomplete :: CharSource.C source => + PartialFallible source a -> Partial source [a] +manyIncomplete p = + let go = absorbException (appendIncomplete p go) + in go + +sepByIncomplete :: CharSource.C source => + Fallible source sep -> PartialFallible source a -> Partial source [a] +sepByIncomplete sep p = + absorbException $ + appendIncomplete p $ + manyIncomplete (sep >> p) + +between :: (CharSource.C source) => + UserMessage -> + Fallible source open -> Fallible source close -> + Partial source a -> PartialFallible source a +between msg open close p = + open >> + CharSource.fallible (terminated msg close p) + +terminated :: (CharSource.C source) => + UserMessage -> + Fallible source close -> + Partial source a -> Partial source a +terminated msg close p = + do enclosed <- p + term <- CharSource.try close + return (enclosed `Async.maybeAbort` + maybe (Just msg) (const Nothing) term) + + +-- mplus +eitherOr :: (CharSource.C source) => + Fallible source a -> Fallible source a -> Fallible source a +eitherOr x y = + CharSource.fallible (CharSource.try x) >>= maybe y return + +deflt :: (CharSource.C source) => + Straight source a -> Fallible source a -> Straight source a +deflt x y = + maybe x return =<< CharSource.try y