{-# LANGUAGE
    ViewPatterns
  , TypeSynonymInstances #-}

-- | Convert lists of strings to records.

module Text.RowRecord
  ( -- * Tables
    Column
  , Row
  , Table
  , fromStrings

    -- * Parsing fields
  , Result  (..)
  , RowError(..)
  , Field   (..)
  , require
  , safeRead
  , getField

    -- * Parsing tables
  , ParseRow(..)
  , parseTable
  ) where

import Control.Applicative
import Control.Monad

import qualified Data.Map as M

-- | Identifies a column.
type Column = String

-- | A row of @'String'@ data.
type Row   = M.Map Column String

-- | A table.
type Table = [Row]

-- | Convert a list of @'String'@ rows into a @'Table'@.
-- Uses the first row as column names.
fromStrings :: [[String]] -> Result Table
fromStrings []     = Failure $ MissingField "header"
fromStrings (h:xs) = Success $ map (M.fromList . zip h) xs

-- | A parse result.
data Result a
  = Success a
  | Failure RowError
  deriving (Show)

-- | Possible errors from parsing a row.
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 of field types which can be decoded from @'String'@.
--
-- The input can be @'Nothing'@ to represent a missing field.
-- The instance @Field a => Field (Maybe a)@ models optional fields.
--
-- If your record contains custom types, you must create a @'Field'@
-- instance for each.  If you have base types but need different 
-- parsing behavior, you can use a @newtype@ wrapper.
class Field a where
  decode :: Maybe String -> Result a

-- | @'read'@ in @'Maybe'@.
safeRead :: (Read a) => String -> Maybe a
safeRead (reads -> [(v,"")]) = Just v
safeRead _ = Nothing

-- | Implement @'decode'@ for a required field.
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

-- | Decode a field by column name.
--
-- Called from TH-generated code, but may be
-- useful independently.
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 of types which can be parsed from a @'Row'@.
-- These types are typically single-constructor records.
--
-- Instances may be generated using @Text.RowRecord.TH@.
class ParseRow a where
  parseRow :: Row -> Result a

-- | Parse a whole table.
parseTable :: (ParseRow a) => Table -> Result [a]
parseTable = mapM parseRow