diff --git a/VKHS.cabal b/VKHS.cabal --- a/VKHS.cabal +++ b/VKHS.cabal @@ -1,6 +1,6 @@ name: VKHS -version: 0.5.3 +version: 0.5.4 synopsis: Provides access to Vkontakte social network via public API description: Provides access to Vkontakte API methods. Library requires no interaction diff --git a/src/Data/Label/Derive.hs b/src/Data/Label/Derive.hs --- a/src/Data/Label/Derive.hs +++ b/src/Data/Label/Derive.hs @@ -176,7 +176,7 @@ record rec fld val = val >>= \v -> recUpdE rec [return (fld, v)] -- Build a function declaration with both a type signature and body. - function (s, b) = liftM2 (,) + function (s, b) = liftM2 (,) (sigD labelName s) (funD labelName [ clause [] (normalB b) [] ]) @@ -195,15 +195,11 @@ prettyTyVar (KindedTV tv ki) = KindedTV (prettyName tv) ki prettyType :: Type -> Type -prettyType (ForallT xs cx ty) = ForallT (map prettyTyVar xs) (map prettyPred cx) (prettyType ty) +prettyType (ForallT xs cx ty) = ForallT (map prettyTyVar xs) (map prettyType cx) (prettyType ty) prettyType (VarT nm ) = VarT (prettyName nm) prettyType (AppT ty tx ) = AppT (prettyType ty) (prettyType tx) prettyType (SigT ty ki ) = SigT (prettyType ty) ki prettyType ty = ty - -prettyPred :: Pred -> Pred -prettyPred (ClassP nm tys) = ClassP (prettyName nm) (map prettyType tys) -prettyPred (EqualP ty tx ) = EqualP (prettyType ty) (prettyType tx) -- IsString instances for TH types. diff --git a/src/Network/Protocol/Cookie.hs b/src/Network/Protocol/Cookie.hs --- a/src/Network/Protocol/Cookie.hs +++ b/src/Network/Protocol/Cookie.hs @@ -104,7 +104,7 @@ -- | Short notation for cookies -data CookieShort = +data CookieShort = CookieShort { _s_name :: String , _s_value :: String @@ -158,10 +158,10 @@ infixr 0 !$ parseSetCookie :: String -> Cookie -parseSetCookie s = +parseSetCookie s = let p = fw (keyValues ";" "=") s in Cookie - { _name = p !$ headMay >>> fmap fst >>> fromMaybe "" + { _name = p !$ headMay >>> fmap fst >>> fromMaybe "" , _value = p !$ headMay >>> fmap snd >>> fromMaybe "" , _comment = p !$ lookup "comment" , _commentURL = p !$ lookup "commentURL" diff --git a/src/Network/Protocol/Http/Data.hs b/src/Network/Protocol/Http/Data.hs --- a/src/Network/Protocol/Http/Data.hs +++ b/src/Network/Protocol/Http/Data.hs @@ -27,7 +27,7 @@ OUT OF THE USE OF THIS SOFTWARE, EVEN IF ADVISED OF THE POSSIBILITY OF SUCH DAMAGE. -} -{-# LANGUAGE TemplateHaskell, TypeOperators #-} +{-# LANGUAGE TemplateHaskell, TypeOperators, KindSignatures #-} module Network.Protocol.Http.Data where import Control.Category diff --git a/src/Test/Debug.hs b/src/Test/Debug.hs --- a/src/Test/Debug.hs +++ b/src/Test/Debug.hs @@ -1,6 +1,5 @@ -- FIXME: in order debug to work {-# LANGUAGE UndecidableInstances #-} -{-# LANGUAGE OverlappingInstances #-} {-# LANGUAGE TypeSynonymInstances #-} {-# LANGUAGE FlexibleInstances #-} @@ -12,9 +11,9 @@ class Debug x where debug :: (MonadIO m) => x -> m () -instance (Show x) => Debug x where +instance {-# OVERLAPPABLE #-} (Show x) => Debug x where debug = liftIO . putStrLn . show . show -instance Debug String where +instance {-# OVERLAPPING #-} Debug String where debug = liftIO . putStrLn . show diff --git a/src/VKQ.hs b/src/VKQ.hs --- a/src/VKQ.hs +++ b/src/VKQ.hs @@ -195,10 +195,10 @@ printf "%s\n" (mr_format fmt m) printf "total %d\n" len --- List audio files +-- List audio files cmd (Options v (Music (MO act True [] fmt _ _ _ _))) = do let e = (envcall act) { verbose = v } - (Response ms) <- api_ e "audio.get" [] + Response (ms :: [MusicRecord]) <- api_ e "audio.get" [] forM_ ms $ \m -> do printf "%s\n" (mr_format fmt m) cmd (Options _ (Music (MO _ False [] _ _ _ [] _))) = do @@ -207,7 +207,7 @@ -- Download audio files cmd (Options v (Music (MO act False [] _ ofmt odir rid sk))) = do let e = (envcall act) { verbose = v } - Response ms <- api_ e "audio.getById" [("audios", concat $ intersperse "," rid)] + Response (ms :: [MusicRecord]) <- api_ e "audio.getById" [("audios", concat $ intersperse "," rid)] forM_ ms $ \m -> do (fp, mh) <- openFileMR odir sk ofmt m case mh of @@ -252,7 +252,7 @@ let (_,ext) = splitExtension (url m) let name = mr_format fmt m let name' = replaceExtension name (takeWhile (/='?') ext) - let fp = (dir name') + let fp = (dir name') e <- doesFileExist fp case (e && sk) of True -> do diff --git a/src/Web/VKHS/API/Aeson.hs b/src/Web/VKHS/API/Aeson.hs --- a/src/Web/VKHS/API/Aeson.hs +++ b/src/Web/VKHS/API/Aeson.hs @@ -48,7 +48,7 @@ parseJSON = parseGeneric instance FromJSON WallRecord where - parseJSON (Object o) = + parseJSON (Object o) = WR <$> (o .: "id") <*> (o .: "to_id") <*> (o .: "from_id") @@ -56,7 +56,7 @@ <*> (o .: "date") parseJSON o = parseJSON_obj_error "WallRecord" o -instance (FromJSON a) => FromJSON (SizedList [a]) where +instance (FromJSON a) => FromJSON (SizedList a) where parseJSON (A.Array v) = do n <- A.parseJSON (V.head v) t <- A.parseJSON (A.Array (V.tail v)) diff --git a/src/Web/VKHS/API/Types.hs b/src/Web/VKHS/API/Types.hs --- a/src/Web/VKHS/API/Types.hs +++ b/src/Web/VKHS/API/Types.hs @@ -7,10 +7,10 @@ import Data.Time.Clock import Data.Time.Clock.POSIX -data Response a = Response a - deriving(Show) +newtype Response a = Response a + deriving (Show) -data SizedList a = SL Int a +data SizedList a = SL Int [a] data MusicRecord = MR { aid :: Int @@ -32,7 +32,7 @@ , faculty :: Maybe Int , faculty_name :: Maybe String , graduation :: Maybe Int - } deriving(Show,Data,Typeable) + } deriving (Show, Data, Typeable) data WallRecord = WR { wid :: Int @@ -40,15 +40,13 @@ , from_id :: Int , wtext :: String , wdate :: Int - } deriving(Show) + } deriving (Show) publishedAt :: WallRecord -> UTCTime publishedAt wr = posixSecondsToUTCTime $ fromIntegral $ wdate wr - data RespError = ER { error_code :: Int , error_msg :: String - } deriving(Show) - + } deriving (Show)