Skip to content

Commit 02c86bf

Browse files
norm2782norm2782
committed
Refactor
1 parent b2e1577 commit 02c86bf

File tree

8 files changed

+44
-42
lines changed

8 files changed

+44
-42
lines changed

‎hgit2.cabal‎

Lines changed: 1 addition & 1 deletion
Original file line numberDiff line numberDiff line change
@@ -57,7 +57,7 @@ Library
5757
Data.HGit2.Object, Data.HGit2.Repository,
5858
Data.HGit2.OID, Data.HGit2.Tree, Data.HGit2.Signature,
5959
Data.HGit2.Types, Data.HGit2.ODB, Data.HGit2.Status,
60-
Data.HGit2.ODBBackend
60+
Data.HGit2.ODBBackend, Data.HGit2.Reflog
6161
Build-Tools: c2hs
6262
CC-Options: -U__BLOCKS__
6363
GHC-Options: -Wall -fwarn-tabs

‎src/haskell/Data/HGit2/Commit.chs‎

Lines changed: 1 addition & 1 deletion
Original file line numberDiff line numberDiff line change
@@ -47,7 +47,7 @@ commitTime :: Commit -> TimeT
4747
commitTime = usCall {#call unsafe git_commit_time#} (return =<<)
4848

4949
timeOffset :: Commit -> Int
50-
timeOffset = usCall {#call unsafe git_commit_time_offset#} (return . fromIntegral =<<)
50+
timeOffset = usCall {#call unsafe git_commit_time_offset#} retNum
5151

5252
committer :: Commit -> Signature
5353
committer = sigCall {#call unsafe git_commit_committer#}

‎src/haskell/Data/HGit2/Config.chs‎

Lines changed: 2 additions & 2 deletions
Original file line numberDiff line numberDiff line change
@@ -69,7 +69,7 @@ newConfig = alloca $ \cfg -> do
6969
-- instances in order. Instances with a higher priority will be accessed first.
7070
addFile :: Config -> ConfigFile -> Int -> IO GitError
7171
addFile (Config c) (ConfigFile f) pr =
72-
return . toEnum . fromIntegral =<< {#call git_config_add_file#} c f (fromIntegral pr)
72+
retEnum $ {#call git_config_add_file#} c f (fromIntegral pr)
7373

7474

7575
-- | Add an on-disk config file instance to an existing config
@@ -85,7 +85,7 @@ addFile (Config c) (ConfigFile f) pr =
8585
addOnDisk :: Config -> String -> Int -> IO GitError
8686
addOnDisk (Config c) pth pr = do
8787
pth' <- newCString pth
88-
return . toEnum . fromIntegral =<< {#call git_config_add_file_ondisk#} c pth' (fromIntegral pr)
88+
retEnum $ {#call git_config_add_file_ondisk#} c pth' (fromIntegral pr)
8989

9090
-- | Create a new config instance containing a single on-disk file
9191
--

‎src/haskell/Data/HGit2/Git2.chs‎

Lines changed: 18 additions & 2 deletions
Original file line numberDiff line numberDiff line change
@@ -20,15 +20,15 @@ instance CWrapper RawData where
2020

2121
wrapToMNum :: (CWrapper a, Num b, Monad m, Integral c) => (CPtr -> m c) -> a
2222
-> m b
23-
wrapToMNum f = (return . fromIntegral =<<) . f . unwrap
23+
wrapToMNum f = retNum . f . unwrap
2424

2525
flipUSCall :: CWrapper a => (b -> IO c) -> (CPtr -> IO b) -> a -> c
2626
flipUSCall f = flip usCall (f =<<)
2727

2828
usCall :: CWrapper a => (CPtr -> b) -> (b -> IO c) -> a -> c
2929
usCall f g = unsafePerformIO . g . f . unwrap
3030

31-
retRes :: CWrapper a => (CPtr -> a) -> CPtr -> IO (Maybe a)
31+
retRes :: (CPtr -> a) -> CPtr -> IO (Maybe a)
3232
retRes w = return . retRes'
3333
where retRes' res | res == nullPtr = Nothing
3434
| otherwise = Just $ w res
@@ -50,3 +50,19 @@ eitherPeekStr ptr = eitherCon (peekCString ptr)
5050

5151
eitherCon :: IO b -> (b -> a) -> CInt -> IOEitherErr a
5252
eitherCon rght con res = retEither res $ fmap (Right . con) $ rght
53+
54+
retNum :: (Num b, Monad m, Integral a) => m a -> m b
55+
retNum a = return . fromIntegral =<< a
56+
57+
retEnum :: (Monad m, Integral a, Enum b) => m a -> m b
58+
retEnum a = return . toEnum . fromIntegral =<< a
59+
60+
callRetCons :: (CWrapper a, Monad m) => (CPtr -> m c) -> (c -> b) -> a -> m b
61+
callRetCons call cons = (return . cons =<<) . call . unwrap
62+
63+
callRetNum :: (CWrapper a, Num b, Monad m, Integral c) => (CPtr -> m c) -> a
64+
-> m b
65+
callRetNum call = retNum . call . unwrap
66+
67+
callRetMaybe :: CWrapper a => (CPtr -> IO CInt) -> a -> IO (Maybe GitError)
68+
callRetMaybe call = (retMaybe =<<) . call . unwrap

‎src/haskell/Data/HGit2/Index.chs‎

Lines changed: 10 additions & 15 deletions
Original file line numberDiff line numberDiff line change
@@ -54,43 +54,41 @@ idxExtFlags = fromEnum IntentToAdd .|. fromEnum SkipWorkTree
5454
-- index file in the provided path, without a repository to back it.
5555
openIndex :: String -> IO (Either GitError Index)
5656
openIndex path = alloca $ \index -> do
57-
pth <- newCString path
58-
res <- {#call git_index_open#} index pth
57+
res <- {#call git_index_open#} index =<< newCString path
5958
retEither res $ fmap (Right . Index) $ peek index
6059

6160
-- | Clear the contents (all the entries) of an index object. This clears the
6261
-- index object in memory; changes must be manually written to disk for them to
6362
-- take effect.
6463
clearIndex :: Index -> IO ()
65-
clearIndex (Index idx) = {#call git_index_clear#} idx
64+
clearIndex = {#call git_index_clear#} . unwrap
6665

6766
-- | Free an existing index object.
6867
freeIndex :: Index -> IO ()
69-
freeIndex (Index idx) = {#call git_index_free#} idx
68+
freeIndex = {#call git_index_free#} . unwrap
7069

7170
-- | Update the contents of an existing index object in memory by reading from
7271
-- the hard disk.
7372
readIndex :: Index -> IO (Maybe GitError)
74-
readIndex (Index idx) = retMaybe =<< {#call git_index_read#} idx
73+
readIndex = callRetMaybe {#call git_index_read#}
7574

7675
-- | Write an existing index object from memory back to disk using an atomic
7776
-- file lock.
7877
writeIndex :: Index -> IO (Maybe GitError)
79-
writeIndex (Index idx) = retMaybe =<< {#call git_index_write#} idx
78+
writeIndex = callRetMaybe {#call git_index_write#}
8079

8180
-- | Find the first index of any entries which point to given path in the Git
8281
-- index.
8382
findIndex :: Index -> String -> IO (Maybe Int)
8483
findIndex (Index idx) path = do
85-
pth <- newCString path
86-
res <- {#call git_index_find#} idx pth
84+
res <- {#call git_index_find#} idx =<< newCString path
8785
return $ if res >= 0
8886
then Just $ fromIntegral res
8987
else Nothing
9088

9189
-- | Remove all entries with equal path except last added
9290
uniqIndex :: Index -> IO ()
93-
uniqIndex (Index idx) = {#call git_index_uniq#} idx
91+
uniqIndex = {#call git_index_uniq#} . unwrap
9492

9593
-- | Add or update an index entry from a file in disk
9694
addIndex :: Index -> String -> Int -> IO (Maybe GitError)
@@ -126,13 +124,11 @@ getIndex (Index idx) n =
126124

127125
-- | Get the count of entries currently in the index
128126
entryCount :: Index -> IO Int
129-
entryCount (Index idx) =
130-
return . fromIntegral =<< {#call git_index_entrycount#} idx
127+
entryCount = callRetNum {#call git_index_entrycount#}
131128

132129
-- | Get the count of unmerged entries currently in the index
133130
entryCountUnMerged :: Index -> IO Int
134-
entryCountUnMerged (Index idx) =
135-
return . fromIntegral =<< {#call git_index_entrycount_unmerged#} idx
131+
entryCountUnMerged = callRetNum {#call git_index_entrycount_unmerged#}
136132

137133
retIEU :: CPtr -> IO (Maybe IndexEntryUnMerged)
138134
retIEU = retRes IndexEntryUnMerged
@@ -149,5 +145,4 @@ unmergedByIndex (Index idx) n =
149145

150146
-- | Return the stage number from a git index entry
151147
entryStage :: IndexEntry -> IO Int
152-
entryStage (IndexEntry ie) =
153-
return . fromIntegral =<< {#call git_index_entry_stage#} ie
148+
entryStage = callRetNum {#call git_index_entry_stage#}

‎src/haskell/Data/HGit2/ODB.chs‎

Lines changed: 2 additions & 4 deletions
Original file line numberDiff line numberDiff line change
@@ -260,10 +260,8 @@ objData = (return . RawData =<<) . {#call git_odb_object_data#} . unwrap
260260
-- This is the real size of the `data` buffer, not the actual size of the
261261
-- object.
262262
odbObjSize :: ODBObj -> IO Integer
263-
odbObjSize =
264-
(return . fromIntegral =<<) . {#call git_odb_object_size#} . unwrap
263+
odbObjSize = retNum . {#call git_odb_object_size#} . unwrap
265264

266265
-- | Return the type of an ODB object
267266
odbObjType :: ODBObj -> IO OType
268-
odbObjType =
269-
(return . toEnum . fromIntegral =<<) . {#call git_odb_object_type#} . unwrap
267+
odbObjType = retEnum . {#call git_odb_object_type#} . unwrap

‎src/haskell/Data/HGit2/Object.chs‎

Lines changed: 3 additions & 6 deletions
Original file line numberDiff line numberDiff line change
@@ -42,7 +42,7 @@ oid (GitObj go) = unsafePerformIO $
4242

4343
-- | Get the object type of an object
4444
objTy :: GitObj -> OType
45-
objTy = unsafePerformIO . (return . toEnum . fromIntegral =<<) .
45+
objTy = unsafePerformIO . retEnum .
4646
{#call unsafe git_object_type#} . unwrap
4747

4848
-- | Get the repository that owns this object
@@ -69,16 +69,14 @@ objOwner = unsafePerformIO . (return . Repository =<<) .
6969
closeObj :: GitObj -> IO ()
7070
closeObj = {#call git_object_close#} . unwrap
7171

72-
7372
-- | Convert an object type to it's string representation.
7473
oTypeToString :: OType -> IO String
7574
oTypeToString oty =
7675
peekCString =<< {#call git_object_type2string#} (fromIntegral $ fromEnum oty)
7776

7877
-- | Convert a string object type representation to it's git_otype.
7978
strToOType :: String -> IO OType
80-
strToOType str = return . toEnum . fromIntegral =<<
81-
{#call git_object_string2type#} =<< newCString str
79+
strToOType = (retEnum . {#call git_object_string2type#} =<<) . newCString
8280

8381
-- | Determine if the given git_otype is a valid loose object type.
8482
isLoose :: OType -> Bool
@@ -88,6 +86,5 @@ isLoose oty = unsafePerformIO $ return . toBool =<<
8886
-- | Get the size in bytes for the structure which acts as an in-memory
8987
-- representation of any given object type.
9088
objSize :: OType -> IO Integer
91-
objSize oty = return . fromIntegral =<< {#call git_object__size#}
92-
(fromIntegral $ fromEnum oty)
89+
objSize = retNum . {#call git_object__size#} . (fromIntegral . fromEnum)
9390

‎src/haskell/Data/HGit2/Tree.chs‎

Lines changed: 7 additions & 11 deletions
Original file line numberDiff line numberDiff line change
@@ -28,17 +28,13 @@ instance CWrapper TreeEntry where
2828
instance CWrapper TreeBuilder where
2929
unwrap (TreeBuilder tb) = tb
3030

31-
ioIntRet :: Integral a => IO a -> IO Int
32-
ioIntRet f = return . fromIntegral =<< f
33-
3431
-- | Get the id of a tree.
3532
treeId :: Tree -> OID
36-
treeId (Tree t) = unsafePerformIO $
37-
return . OID =<< {#call git_tree_id#} t
33+
treeId = unsafePerformIO . callRetCons {#call git_tree_id#} OID
3834

3935
-- | Get the number of entries listed in a tree
4036
entryCount :: Tree -> IO Int
41-
entryCount (Tree t) = ioIntRet $ {#call git_tree_entrycount#} t
37+
entryCount = retNum . {#call git_tree_entrycount#} . unwrap
4238

4339
-- | Lookup a tree entry by its filename
4440
entryByName :: Tree -> String -> IO TreeEntry
@@ -52,15 +48,15 @@ entryByIndex (Tree t) n =
5248

5349
-- | Get the UNIX file attributes of a tree entry
5450
attributes :: TreeEntry -> IO Int
55-
attributes (TreeEntry e) = ioIntRet $ {#call git_tree_entry_attributes#} e
51+
attributes = retNum . {#call git_tree_entry_attributes#} . unwrap
5652

5753
-- | Get the filename of a tree entry
5854
name :: TreeEntry -> IO String
59-
name (TreeEntry t) = peekCString =<< {#call git_tree_entry_name#} t
55+
name = (peekCString =<<) . {#call git_tree_entry_name#} . unwrap
6056

6157
-- | Get the id of the object pointed by the entry
6258
entryId :: TreeEntry -> IO OID
63-
entryId (TreeEntry t) = fmap OID $ {#call git_tree_entry_id#} t
59+
entryId = callRetCons {#call git_tree_entry_id#} OID
6460

6561
-- | Get the type of the object pointed by the entry
6662
entryType :: TreeEntry -> IO OType
@@ -89,11 +85,11 @@ createTreeBuilder tr = alloca $ \builder -> do
8985

9086
-- | Clear all the entires in the builder
9187
clearTreeBuilder :: TreeBuilder -> IO ()
92-
clearTreeBuilder (TreeBuilder t) = {#call git_treebuilder_clear#} t
88+
clearTreeBuilder = {#call git_treebuilder_clear#} . unwrap
9389

9490
-- | Free a tree builder
9591
freeTreeBuilder :: TreeBuilder -> IO ()
96-
freeTreeBuilder (TreeBuilder t) = {#call git_treebuilder_free#} t
92+
freeTreeBuilder = {#call git_treebuilder_free#} . unwrap
9793

9894
-- Get an entry from the builder from its filename
9995
getTreeBuilder :: TreeBuilder -> String -> IO (Maybe TreeEntry)

0 commit comments

Comments
 (0)