module Airtable.Table
(
Record(..)
, RecordID(..)
, rec2str
, HasRecordId(..)
, Table(..)
, TableName
, fromRecords
, fromList
, toList
, exists
, select
, vSelect
, selectMaybe
, vSelectMaybe
, selectAll
, vSelectAll
, selectAllKeys
, selectWhere
, vSelectWhere
, selectKeyWhere
, vSelectKeyWhere
, deleteWhere
, vDeleteWhere
) 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
, ToJSON
, Show
, Read
, Eq
, Generic
, Ord
)
instance Hashable RecordID
rec2str :: RecordID -> String
rec2str (RecordID rec) = T.unpack rec
class HasRecordId a where
toRecId :: a -> RecordID
instance HasRecordId RecordID where
toRecId = id
instance HasRecordId String where
toRecId = RecordID . T.pack
data Record a = Record
{ recordId :: RecordID
, recordObj :: a
, createdTime :: UTCTime
} deriving ( Show
, Read
, Generic
, Eq
, Ord
, Functor
)
instance (FromJSON a) => FromJSON (Record a) where
parseJSON = withObject "record object" $ \v -> do
Record <$> v .: "id"
<*> v .: "fields"
<*> v .: "createdTime"
instance (ToJSON a) => ToJSON (Record a) where
toJSON rec = object [ "id" .= recordId rec
, "fields" .= recordObj rec
, "createdTime" .= createdTime rec
]
instance HasRecordId (Record a) where
toRecId = recordId
data Table a = Table
{ tableRecords :: Map.HashMap RecordID (Record 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"
offset <- v .:? "offset"
return $ (fromRecords recs) { tableOffset = offset }
instance (ToJSON a) => ToJSON (Table a) where
toJSON tbl = object [ "offset" .= tableOffset tbl
, "records" .= selectAll tbl
]
instance Monoid (Table a) where
mempty = Table mempty Nothing
mappend (Table t1 o) (Table t2 _) = Table (mappend t1 t2) o
fromRecords :: [Record a] -> Table a
fromRecords recs = fromList $ zip (map recordId recs) recs
fromList :: [(RecordID, Record a)] -> Table a
fromList pairs = Table
{ tableRecords = Map.fromList pairs
, tableOffset = Nothing
}
toList :: Table a -> [(RecordID, Record a)]
toList = Map.toList . tableRecords
exists :: (HasRecordId r) => Table a -> r -> Bool
exists tbl rec = Map.member (toRecId rec) (tableRecords tbl)
select :: (HasCallStack, HasRecordId r, Show a) => Table a -> r -> Record 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
vSelect :: (HasCallStack, HasRecordId r, Show a) => Table a -> r -> a
vSelect tbl rec = recordObj (select tbl rec)
selectMaybe :: (HasRecordId r) => Table a -> r -> Maybe (Record a)
selectMaybe tbl rec = toRecId rec `Map.lookup` tableRecords tbl
vSelectMaybe :: (HasRecordId r) => Table a -> r -> Maybe a
vSelectMaybe tbl rec = recordObj <$> selectMaybe tbl rec
selectAll :: Table a -> [Record a]
selectAll = map snd . toList
vSelectAll :: Table a -> [a]
vSelectAll = map recordObj . selectAll
selectAllKeys :: Table a -> [RecordID]
selectAllKeys = map fst . toList
selectWhere :: Table a -> (Record a -> Bool) -> [Record a]
selectWhere tbl f = filter f (selectAll tbl)
vSelectWhere :: Table a -> (a -> Bool) -> [a]
vSelectWhere tbl f = filter f (vSelectAll tbl)
selectKeyWhere :: Table a -> (Record a -> Bool) -> [RecordID]
selectKeyWhere tbl f = map recordId (selectWhere tbl f)
vSelectKeyWhere :: Table a -> (a -> Bool) -> [RecordID]
vSelectKeyWhere tbl f = selectKeyWhere tbl (f . recordObj)
deleteWhere :: Table a -> (Record a -> Bool) -> Table a
deleteWhere (Table recs off) f = Table (Map.filter (\v -> not $ f v) recs) off
vDeleteWhere :: Table a -> (a -> Bool) -> Table a
vDeleteWhere tbl f = deleteWhere tbl (f . recordObj)