module Text.RowRecord
(
Column
, Row
, Table
, fromStrings
, Result (..)
, RowError(..)
, Field (..)
, require
, safeRead
, getField
, ParseRow(..)
, parseTable
) where
import Control.Applicative
import Control.Monad
import qualified Data.Map as M
type Column = String
type Row = M.Map Column String
type Table = [Row]
fromStrings :: [[String]] -> Result Table
fromStrings [] = Failure $ MissingField "header"
fromStrings (h:xs) = Success $ map (M.fromList . zip h) xs
data Result a
= Success a
| Failure RowError
deriving (Show)
data RowError
= MissingField Column
| NoParse Column String
deriving (Show)
instance Functor Result where
fmap f (Success v) = Success $ f v
fmap _ (Failure e) = Failure e
instance Monad Result where
return = Success
Success x >>= f = f x
Failure e >>= _ = Failure e
instance Applicative Result where
pure = return
(<*>) = ap
class Field a where
decode :: Maybe String -> Result a
safeRead :: (Read a) => String -> Maybe a
safeRead (reads -> [(v,"")]) = Just v
safeRead _ = Nothing
require :: (String -> Maybe a) -> Maybe String -> Result a
require _ Nothing = Failure $ MissingField ""
require f (Just (f -> Just v)) = Success v
require _ (Just xs) = Failure $ NoParse "" xs
instance Field Bool where decode = require safeRead
instance Field Int where decode = require safeRead
instance Field Integer where decode = require safeRead
instance Field Float where decode = require safeRead
instance Field Double where decode = require safeRead
instance Field String where decode = require Just
instance Field Char where
decode = require f where
f [x] = Just x
f _ = Nothing
instance (Field a) => Field (Maybe a) where
decode Nothing = Success Nothing
decode (Just "") = Success Nothing
decode (decode -> r) = Just <$> r
getField :: (Field a) => Column -> Row -> Result a
getField k m = case decode $ M.lookup k m of
v@(Success _) -> v
Failure e -> Failure $ case e of
MissingField _ -> MissingField k
(NoParse _ s) -> NoParse k s
class ParseRow a where
parseRow :: Row -> Result a
parseTable :: (ParseRow a) => Table -> Result [a]
parseTable = mapM parseRow