diff --git a/airtable-api.cabal b/airtable-api.cabal --- a/airtable-api.cabal +++ b/airtable-api.cabal @@ -1,6 +1,6 @@ name: airtable-api -version: 0.1.0.4 -synopsis: Requesting and introspecting Tables within an Airtable project. +version: 0.2.0.0 +synopsis: Requesting and introspecting Tables within an Airtable project. -- description: homepage: https://github.com/ooblahman/airtable-api license: BSD3 @@ -25,6 +25,7 @@ , hashable , lens , unordered-containers + , time default-language: Haskell2010 test-suite airtable-api-test diff --git a/src/Airtable/Query.hs b/src/Airtable/Query.hs --- a/src/Airtable/Query.hs +++ b/src/Airtable/Query.hs @@ -4,6 +4,7 @@ ( module Airtable.Table -- * Configuration for Airtable requests. , AirtableOptions(..) + , defaultAirtableOptions -- * Main API , getTable ) where @@ -23,36 +24,36 @@ data AirtableOptions = AirtableOptions { -- | the API key for your project apiKey :: String - -- | the app ID for your project (http://api.airtable.com/v0/...) - , appId :: String - -- | api version (http://api.airtable.com/v../...) + -- | the app ID for your project (http:\/\/api.airtable.com\/v0\/app...) + , appId :: String + -- | api version (http:\/\/api.airtable.com\/v..\/...) , apiVersion :: Int } --- | Airtable options defaulting to API version 0. Please change the +-- | Airtable options defaulting to API version 0. Please change the -- 'apiKey' and 'appId' fields. -defaultOptions :: AirtableOptions -defaultOptions = AirtableOptions { +defaultAirtableOptions :: AirtableOptions +defaultAirtableOptions = AirtableOptions { apiKey = "" , appId = "" , apiVersion = 0 } --- | Base airtable API string. +-- | Base airtable API string. base_url :: String base_url = "https://api.airtable.com/" -- | Retrieve a table from airtable.com given its name. Handles pagination correctly. getTable :: (FromJSON a) => AirtableOptions -> TableName -> IO (Table a) -getTable opts tname = getTableFromUrl net_otps url +getTable opts tname = getTableFromUrl net_otps url where - net_otps = defaults & header "Authorization" .~ ["Bearer " <> BC.pack (apiKey opts)] - url = base_url - <> "v" - <> show (apiVersion opts) - <> "/" - <> appId opts - <> "/" + net_otps = defaults & header "Authorization" .~ ["Bearer " <> BC.pack (apiKey opts)] + url = base_url + <> "v" + <> show (apiVersion opts) + <> "/" + <> appId opts + <> "/" <> tname getTableFromUrl :: (FromJSON a) => Options -> String -> IO (Table a) @@ -60,15 +61,15 @@ resp <- getWith opts url getMore (fromResp resp) where - getMore tbl = case tableOffset tbl of + getMore tbl = case tableOffset tbl of Just offset -> do resp <- getWith (opts & param "offset" .~ [offset]) url getMore $ fromResp resp <> tbl - Nothing -> + Nothing -> pure tbl fromResp r = decoder $ r ^. responseBody where - decoder b = case eitherDecode b of + decoder b = case eitherDecode b of Left e -> error $ e <> "\nSource string: " <> show b Right r -> r diff --git a/src/Airtable/Table.hs b/src/Airtable/Table.hs --- a/src/Airtable/Table.hs +++ b/src/Airtable/Table.hs @@ -3,17 +3,20 @@ {-# LANGUAGE TypeSynonymInstances #-} {-# LANGUAGE FlexibleInstances #-} {-# LANGUAGE GeneralizedNewtypeDeriving #-} +{-# LANGUAGE DeriveFunctor #-} module Airtable.Table - ( - -- * RecordID + ( + -- * RecordID RecordID(..) , rec2str -- * IsRecord class , IsRecord(..) - -- * Table + -- * Table , Table(..) , TableName + , parseRecord + , parseFields -- * Table methods , toList , exists @@ -41,9 +44,10 @@ import Data.Monoid import Data.Hashable import Data.Foldable (foldlM) +import Data.Time (UTCTime) --- * RecordID +-- * RecordID -- | Airtable's record ID for use in indexing records newtype RecordID = RecordID Text deriving ( FromJSON @@ -54,7 +58,7 @@ , Ord ) -instance Hashable RecordID +instance Hashable RecordID rec2str :: RecordID -> String rec2str (RecordID rec) = T.unpack rec @@ -69,18 +73,19 @@ toRec = id instance IsRecord String where - toRec = RecordID . T.pack + toRec = RecordID . T.pack --- * Table +-- * Table -- | Airtable's table type data Table a = Table { tableRecords :: Map.HashMap RecordID a , tableOffset :: Maybe Text - } deriving - ( Show + } deriving + ( Show , Read , Eq , Generic + , Functor ) -- | Synonym used in querying tables from the API. @@ -93,12 +98,26 @@ offset <- v .:? "offset" return $ Table parsedRecs offset where - parseRec tbl (Object v) = + parseRec tbl json@(Object v) = do recId <- v .: "id" - obj <- v .: "fields" + obj <- parseJSON json return $ Map.insert recId obj tbl - <|> error ("could not decode: " <> show v) + parseRec tbl invalid = typeMismatch "Table" invalid + parseJSON invalid = typeMismatch "Table" invalid + +parseRecord :: (UTCTime -> RecordID -> Value -> Parser a) -> Value -> Parser a +parseRecord action (Object v) = do + created <- v .: "createdTime" + recordId <- v .: "id" + fields <- v .: "fields" + action created recordId fields +parseRecord _action invalid = typeMismatch "parseFields" invalid + +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 @@ -118,13 +137,13 @@ select :: (HasCallStack, IsRecord r, Show a) => Table a -> r -> a select tbl rec = tableRecords tbl `lookup` toRec rec where - lookup mp k = case Map.lookup k mp of + lookup mp k = case Map.lookup k mp of Just v -> v Nothing -> error $ "lookup failed in map: " <> show k -- | Safely lookup a record using its RecordID. selectMaybe :: (IsRecord r) => Table a -> r -> Maybe a -selectMaybe tbl rec = toRec rec `Map.lookup` tableRecords tbl +selectMaybe tbl rec = toRec rec `Map.lookup` tableRecords tbl -- | Read all records. selectAll :: Table a -> [a] @@ -134,7 +153,7 @@ selectAllKeys :: Table a -> [RecordID] selectAllKeys = map fst . toList --- | Select all records satisfying a condition. +-- | Select all records satisfying a condition. selectWhere :: Table a -> (RecordID -> a -> Bool) -> [a] selectWhere tbl f = map snd $ filter (uncurry f) (toList tbl) @@ -142,6 +161,6 @@ selectKeyWhere :: Table a -> (RecordID -> a -> Bool) -> [RecordID] selectKeyWhere tbl f = map fst $ filter (uncurry f) (toList tbl) --- | Delete all Records satisfying a condition. +-- | Delete all Records satisfying a condition. deleteWhere :: Table a -> (RecordID -> a -> Bool) -> Table a deleteWhere (Table recs off) f = Table (Map.filterWithKey (\k v -> not $ f k v) recs) off