diff --git a/LICENSE b/LICENSE new file mode 100644 --- /dev/null +++ b/LICENSE @@ -0,0 +1,30 @@ +Copyright Fernando Rincon Martin (c) 2017 + +All rights reserved. + +Redistribution and use in source and binary forms, with or without +modification, are permitted provided that the following conditions are met: + + * Redistributions of source code must retain the above copyright + notice, this list of conditions and the following disclaimer. + + * Redistributions in binary form must reproduce the above + copyright notice, this list of conditions and the following + disclaimer in the documentation and/or other materials provided + with the distribution. + + * Neither the name of Author name here nor the names of other + contributors may be used to endorse or promote products derived + from this software without specific prior written permission. + +THIS SOFTWARE IS PROVIDED BY THE COPYRIGHT HOLDERS AND CONTRIBUTORS +"AS IS" AND ANY EXPRESS OR IMPLIED WARRANTIES, INCLUDING, BUT NOT +LIMITED TO, THE IMPLIED WARRANTIES OF MERCHANTABILITY AND FITNESS FOR +A PARTICULAR PURPOSE ARE DISCLAIMED. IN NO EVENT SHALL THE COPYRIGHT +OWNER OR CONTRIBUTORS BE LIABLE FOR ANY DIRECT, INDIRECT, INCIDENTAL, +SPECIAL, EXEMPLARY, OR CONSEQUENTIAL DAMAGES (INCLUDING, BUT NOT +LIMITED TO, PROCUREMENT OF SUBSTITUTE GOODS OR SERVICES; LOSS OF USE, +DATA, OR PROFITS; OR BUSINESS INTERRUPTION) HOWEVER CAUSED AND ON ANY +THEORY OF LIABILITY, WHETHER IN CONTRACT, STRICT LIABILITY, OR TORT +(INCLUDING NEGLIGENCE OR OTHERWISE) ARISING IN ANY WAY OUT OF THE USE +OF THIS SOFTWARE, EVEN IF ADVISED OF THE POSSIBILITY OF SUCH DAMAGE. diff --git a/README.md b/README.md new file mode 100644 --- /dev/null +++ b/README.md @@ -0,0 +1,2 @@ +# ping-parser-attoparsec +[![Travis](https://img.shields.io/travis/frincon/ping-wrapper.svg)](https://travis-ci.org/frincon/ping-wrapper) [![Hackage](https://img.shields.io/hackage/v/ping-wrapper.svg)](http://hackage.haskell.org/package/ping-wrapper) diff --git a/Setup.hs b/Setup.hs new file mode 100644 --- /dev/null +++ b/Setup.hs @@ -0,0 +1,3 @@ +import Distribution.Simple + +main = defaultMain diff --git a/app/Main.hs b/app/Main.hs new file mode 100644 --- /dev/null +++ b/app/Main.hs @@ -0,0 +1,26 @@ +-- Copyright 2017 Fernando Rincon Martin +-- +-- Licensed under the Apache License, Version 2.0 (the "License"); +-- you may not use this file except in compliance with the License. +-- You may obtain a copy of the License at +-- +-- http://www.apache.org/licenses/LICENSE-2.0 +-- +-- Unless required by applicable law or agreed to in writing, software +-- distributed under the License is distributed on an "AS IS" BASIS, +-- WITHOUT WARRANTIES OR CONDITIONS OF ANY KIND, either express or implied. +-- See the License for the specific language governing permissions and +-- limitations under the License. +{-# LANGUAGE OverloadedStrings #-} + +import Options.Generic + +import Ping (PingOptions, performPing) + +instance ParseRecord PingOptions + +main :: IO () +main = do + options <- getRecord "ping-wrapper" + result <- performPing options + print result diff --git a/linux/src/Ping/Platform.hs b/linux/src/Ping/Platform.hs new file mode 100644 --- /dev/null +++ b/linux/src/Ping/Platform.hs @@ -0,0 +1,32 @@ +-- Copyright 2017 Fernando Rincon Martin +-- +-- Licensed under the Apache License, Version 2.0 (the "License"); +-- you may not use this file except in compliance with the License. +-- You may obtain a copy of the License at +-- +-- http://www.apache.org/licenses/LICENSE-2.0 +-- +-- Unless required by applicable law or agreed to in writing, software +-- distributed under the License is distributed on an "AS IS" BASIS, +-- WITHOUT WARRANTIES OR CONDITIONS OF ANY KIND, either express or implied. +-- See the License for the specific language governing permissions and +-- limitations under the License. +{-# LANGUAGE TemplateHaskell #-} + +module Ping.Platform + ( pingParameters + , parseResult + ) where + +import Development.Placeholders + +import Data.Attoparsec.Ping +import Data.Attoparsec.Text (parseOnly) +import qualified Data.Text as T +import Ping.CommonTypes + +pingParameters :: PingOptions -> [String] +pingParameters opts = $notImplemented + +parseResult :: String -> Either String PingResult +parseResult stdout = $notImplemented diff --git a/ping-wrapper.cabal b/ping-wrapper.cabal new file mode 100644 --- /dev/null +++ b/ping-wrapper.cabal @@ -0,0 +1,57 @@ +name: ping-wrapper +version: 0.1.0.0 +synopsis: Haskell Ping wrapper +description: + This utility is a wrapper for ping. Currently it is only implemented the + win32 and it will raise an exception in other systems. +homepage: https://github.com/frincon/ping-wrapper +license: Apache-2.0 +license-file: LICENSE +author: Fernando Rincon Martin +maintainer: frm.rincon@gmail.com +copyright: (c) 2017, Fernando Rincon Martin +category: Attoparsec, Parsers +build-type: Simple +extra-source-files: README.md +cabal-version: >=1.10 + +library + hs-source-dirs: src + if os(win32) + hs-source-dirs: win32/src + if os(linux) + hs-source-dirs: linux/src + exposed-modules: Ping + other-modules: Ping.CommonTypes + , Ping.Platform + build-depends: base >= 4.7 && < 5 + , ping-parser-attoparsec + , attoparsec + , placeholders + , process + , text + , either + default-language: Haskell2010 + +executable ping-wrapper + hs-source-dirs: app + main-is: Main.hs + ghc-options: -threaded -rtsopts -with-rtsopts=-N + build-depends: base + , ping-wrapper + , optparse-generic + , optparse-applicative + default-language: Haskell2010 + +test-suite ping-wrapper-test + type: exitcode-stdio-1.0 + hs-source-dirs: test + main-is: Spec.hs + build-depends: base + , ping-wrapper + ghc-options: -threaded -rtsopts -with-rtsopts=-N + default-language: Haskell2010 + +source-repository head + type: git + location: https://github.com/frincon/ping-wrapper diff --git a/src/Ping.hs b/src/Ping.hs new file mode 100644 --- /dev/null +++ b/src/Ping.hs @@ -0,0 +1,55 @@ +-- Copyright 2017 Fernando Rincon Martin +-- +-- Licensed under the Apache License, Version 2.0 (the "License"); +-- you may not use this file except in compliance with the License. +-- You may obtain a copy of the License at +-- +-- http://www.apache.org/licenses/LICENSE-2.0 +-- +-- Unless required by applicable law or agreed to in writing, software +-- distributed under the License is distributed on an "AS IS" BASIS, +-- WITHOUT WARRANTIES OR CONDITIONS OF ANY KIND, either express or implied. +-- See the License for the specific language governing permissions and +-- limitations under the License. +{-# LANGUAGE TemplateHaskell #-} + +-- | +-- Copyright: 2017 Fernando Rincon Martin +-- License: Apache-2.0 +-- +-- Maintainer : frm.rincon@gmail.com +-- Stability : experimental +-- +-- Ping wrapper. +-- +-- It calls ping utility and parse the result in a haskell data type. +-- +-- Currently only support win32 platform +module Ping + ( PingOptions(..) + , PingResult(..) + , performPing + ) where + +import Data.Attoparsec.Ping +import Data.Attoparsec.Text (parseOnly) +import Data.Either.Combinators (mapLeft) +import Data.List (intercalate) +import Development.Placeholders +import System.Process (readProcessWithExitCode) + +import Ping.CommonTypes +import Ping.Platform + +-- | Execute synchronously the ping and return the parsed result +performPing :: PingOptions -> IO (Either String PingResult) +performPing opts = + let parameters = pingParameters opts + in do (exitCode, stdout, stderr) <- + readProcessWithExitCode "ping" parameters "" + return $ addContextToLeft stdout $ parseResult stdout + where + addContextToLeft stdout = mapLeft (addContext stdout) + addContext stdout errorString = + errorString ++ + "\n" ++ "StdOut:\n" ++ unlines (fmap (\x -> " " ++ x) (lines stdout)) diff --git a/src/Ping/CommonTypes.hs b/src/Ping/CommonTypes.hs new file mode 100644 --- /dev/null +++ b/src/Ping/CommonTypes.hs @@ -0,0 +1,25 @@ +-- Copyright 2017 Fernando Rincon Martin +-- +-- Licensed under the Apache License, Version 2.0 (the "License"); +-- you may not use this file except in compliance with the License. +-- You may obtain a copy of the License at +-- +-- http://www.apache.org/licenses/LICENSE-2.0 +-- +-- Unless required by applicable law or agreed to in writing, software +-- distributed under the License is distributed on an "AS IS" BASIS, +-- WITHOUT WARRANTIES OR CONDITIONS OF ANY KIND, either express or implied. +-- See the License for the specific language governing permissions and +-- limitations under the License. +{-# LANGUAGE DeriveGeneric #-} + +module Ping.CommonTypes + ( PingOptions(..) + ) where + +import GHC.Generics + +data PingOptions = PingOptions + { hostNameOrAddress :: String + , count :: Int + } deriving (Show, Generic) diff --git a/test/Spec.hs b/test/Spec.hs new file mode 100644 --- /dev/null +++ b/test/Spec.hs @@ -0,0 +1,2 @@ +main :: IO () +main = putStrLn "Test suite not yet implemented" diff --git a/win32/src/Ping/Platform.hs b/win32/src/Ping/Platform.hs new file mode 100644 --- /dev/null +++ b/win32/src/Ping/Platform.hs @@ -0,0 +1,32 @@ +-- Copyright 2017 Fernando Rincon Martin +-- +-- Licensed under the Apache License, Version 2.0 (the "License"); +-- you may not use this file except in compliance with the License. +-- You may obtain a copy of the License at +-- +-- http://www.apache.org/licenses/LICENSE-2.0 +-- +-- Unless required by applicable law or agreed to in writing, software +-- distributed under the License is distributed on an "AS IS" BASIS, +-- WITHOUT WARRANTIES OR CONDITIONS OF ANY KIND, either express or implied. +-- See the License for the specific language governing permissions and +-- limitations under the License. +{-# LANGUAGE TemplateHaskell #-} + +module Ping.Platform + ( pingParameters + , parseResult + ) where + +import Development.Placeholders + +import Data.Attoparsec.Ping.Win32 +import Data.Attoparsec.Text (parseOnly) +import qualified Data.Text as T +import Ping.CommonTypes + +pingParameters :: PingOptions -> [String] +pingParameters opts = ["-n", show $ count opts, hostNameOrAddress opts] + +parseResult :: String -> Either String PingResult +parseResult stdout = parseOnly pingParser (T.pack stdout)