module Airtable.Table
(
Record(..)
, RecordID(..)
, rec2str
, IsRecord(..)
, Table(..)
, TableName
, parseRecord
, parseFields
, toList
, exists
, select
, selectMaybe
, selectAll
, selectAllKeys
, selectWhere
, selectKeyWhere
, deleteWhere
) where
import GHC.Generics
import GHC.Stack
import Control.Applicative ((<|>))
import Data.HashMap.Strict (HashMap)
import qualified Data.HashMap.Strict as Map
import Data.Aeson
import Data.Aeson.Types
import Data.Text (Text)
import qualified Data.Text as T
import Data.Monoid
import Data.Hashable
import Data.Foldable (foldlM)
import Data.Time (UTCTime)
newtype RecordID = RecordID Text deriving ( FromJSON
, Show
, Read
, Eq
, Generic
, Ord
)
instance Hashable RecordID
rec2str :: RecordID -> String
rec2str (RecordID rec) = T.unpack rec
class IsRecord a where
toRecId :: a -> RecordID
instance IsRecord RecordID where
toRecId = id
instance IsRecord String where
toRecId = RecordID . T.pack
data Record a = Record { recordId :: RecordID, recordObj :: a, createdTime :: UTCTime }
instance (FromJSON a) => FromJSON (Record a) where
parseJSON = withObject "record object" $ \v -> do
Record <$> v .: "id"
<*> v .: "fields"
<*> v .: "createdTime"
instance IsRecord (Record a) where
toRecId = recordId
data Table a = Table { tableRecords :: Map.HashMap RecordID a
, tableOffset :: Maybe Text
} deriving
( Show
, Read
, Eq
, Generic
, Functor
)
type TableName = String
instance (FromJSON a) => FromJSON (Table a) where
parseJSON = withObject "table object" $ \v -> do
recs <- v .: "records" :: Parser [Value]
parsedRecs <- foldlM parseRec Map.empty recs
offset <- v .:? "offset"
return $ Table parsedRecs offset
where
parseRec tbl = withObject "record object" $ \v ->
do recId <- v .: "id"
fields <- v .: "fields"
obj <- parseJSON fields
return $ Map.insert recId obj tbl
parseRecord :: (UTCTime -> RecordID -> Value -> Parser a) -> Value -> Parser a
parseRecord action = withObject "record object" $ \v -> do
created <- v .: "createdTime"
recordId <- v .: "id"
fields <- v .: "fields"
action created recordId fields
parseFields :: (Value -> Parser a) -> Value -> Parser a
parseFields action (Object v) = v .: "fields" >>= action
parseFields _action invalid = typeMismatch "parseFields_" invalid
instance Monoid (Table a) where
mempty = Table mempty Nothing
mappend (Table t1 o) (Table t2 _) = Table (mappend t1 t2) o
toList :: Table a -> [(RecordID, a)]
toList = Map.toList . tableRecords
exists :: (IsRecord r) => Table a -> r -> Bool
exists tbl rec = Map.member (toRecId rec) (tableRecords tbl)
select :: (HasCallStack, IsRecord r, Show a) => Table a -> r -> a
select tbl rec = tableRecords tbl `lookup` toRecId rec
where
lookup mp k = case Map.lookup k mp of
Just v -> v
Nothing -> error $ "lookup failed in map: " <> show k
selectMaybe :: (IsRecord r) => Table a -> r -> Maybe a
selectMaybe tbl rec = toRecId rec `Map.lookup` tableRecords tbl
selectAll :: Table a -> [a]
selectAll = map snd . toList
selectAllKeys :: Table a -> [RecordID]
selectAllKeys = map fst . toList
selectWhere :: Table a -> (RecordID -> a -> Bool) -> [a]
selectWhere tbl f = map snd $ filter (uncurry f) (toList tbl)
selectKeyWhere :: Table a -> (RecordID -> a -> Bool) -> [RecordID]
selectKeyWhere tbl f = map fst $ filter (uncurry f) (toList tbl)
deleteWhere :: Table a -> (RecordID -> a -> Bool) -> Table a
deleteWhere (Table recs off) f = Table (Map.filterWithKey (\k v -> not $ f k v) recs) off