Add instance IsString for ClientInfo

3 files changed, 32 insertions, 4 deletions

diff --git a/bittorrent.cabal b/bittorrent.cabal
index 846b5b16..3c9c0d38 100644
--- a/bittorrent.cabal
+++ b/bittorrent.cabal
@@ -98,6 +98,7 @@ library
                      , data-default
                      , IntervalMap
                      , intset
+                     , split
                      , text        >= 0.11.0
                      , unordered-containers
                      , vector
diff --git a/src/Data/Torrent/Client.hs b/src/Data/Torrent/Client.hs
index a7e94513..f38f7a5c 100644
--- a/src/Data/Torrent/Client.hs
+++ b/src/Data/Torrent/Client.hs
@@ -34,10 +34,14 @@ import Data.ByteString as BS
 import Data.ByteString.Char8 as BC
 import Data.Default
 import Data.List as L
+import Data.List.Split as L
+import Data.Maybe
 import Data.Monoid
+import Data.String
 import Data.Text as T
 import Data.Version
 import Text.PrettyPrint hiding ((<>))
+import Text.Read (readMaybe)
 import Paths_bittorrent (version)
 
 
@@ -111,6 +115,15 @@ data ClientImpl =
 -- | Used to represent a not recognized implementation
 instance Default ClientImpl where
   def = IUnknown
+  {-# INLINE def #-}
+
+instance IsString ClientImpl where
+  fromString str
+    | Just impl <- L.lookup str alist = impl
+    | otherwise = error $ "fromString: not recognized " ++ str
+    where
+      alist = L.map mk [minBound..maxBound]
+      mk  x = (L.tail $ show x, x)
 
 -- | Format client implementation info in human-readable form.
 ppClientImpl :: ClientImpl -> Doc
@@ -119,6 +132,14 @@ ppClientImpl = text . L.tail . show
 -- | Just the '0' version.
 instance Default Version where
   def = Version [0] []
+  {-# INLINE def #-}
+
+instance IsString Version where
+  fromString str
+    | Just nums <- chunkNums str = Version nums []
+    | otherwise = error $ "fromString: invalid version string " ++ str
+    where
+      chunkNums = sequence . L.map readMaybe . L.linesBy ('.' ==)
 
 -- | Format client implementation version in human-readable form.
 ppVersion :: Version -> Doc
@@ -134,6 +155,14 @@ data ClientInfo = ClientInfo {
 -- | Unrecognized client implementation.
 instance Default ClientInfo where
   def = ClientInfo def def
+  {-# INLINE def #-}
+
+instance IsString ClientInfo where
+  fromString str
+    | _ : ver <- _ver = ClientInfo (fromString impl) (fromString ver)
+    | otherwise = error $ "fromString: invalid client info string" ++ str
+    where
+      (impl, _ver) = L.span ((/=) '-') str
 
 -- | Format client info in human-readable form.
 ppClientInfo :: ClientInfo -> Doc
diff --git a/tests/Data/Torrent/ClientSpec.hs b/tests/Data/Torrent/ClientSpec.hs
index 85ace5e0..890ee95e 100644
--- a/tests/Data/Torrent/ClientSpec.hs
+++ b/tests/Data/Torrent/ClientSpec.hs
@@ -10,7 +10,5 @@ spec :: Spec
 spec = do
   describe "client info" $ do
     it "decode azureus encoded peer id" $ do
-      clientInfo "-AZ2060-xxxxxxxxxxxx" `shouldBe`
-        ClientInfo IAzureus (Version [2060] [])
-      clientInfo "-BS0000-xxxxxxxxxxxx" `shouldBe`
-        ClientInfo IBTSlave (Version [0] [])
+      clientInfo "-AZ2060-xxxxxxxxxxxx" `shouldBe` "Azureus-2060"
+      clientInfo "-BS0000-xxxxxxxxxxxx" `shouldBe` "BTSlave-0"