Refactor

Add annotations, fix -Wall warnings, lint, etc.

4 files changed, 81 insertions, 42 deletions

diff --git a/Coalpit.hs b/Coalpit.hs
index 2e5167c..e00350c 100644
--- a/Coalpit.hs
+++ b/Coalpit.hs
@@ -1,3 +1,16 @@
+{- |
+Description :  Command-line options parsing and printing
+Maintainer  :  defanor <defanor@uberspace.net>
+Stability   :  unstable
+Portability :  non-portable (uses GHC extensions)
+
+Coalpit is a library for building "command-line program interfaces":
+the goal is to get interfaces between programs quickly and easily,
+while keeping them language-agnostic and more user- and shell
+scripting-friendly than JSON and similar formats.
+
+-}
+
 {-# LANGUAGE TypeFamilies #-}
 {-# LANGUAGE TypeOperators #-}
 {-# LANGUAGE DefaultSignatures #-}
@@ -5,25 +18,42 @@
 {-# LANGUAGE FlexibleInstances #-}
 {-# LANGUAGE ScopedTypeVariables #-}
 
-module Coalpit where
+module Coalpit (
+  -- * Core classes
+  ArgParser(..)
+  , ToArgs(..)
+  -- * Utility functions
+  , fromArgs
+  -- * Modifiers
+  , Modifiers(..)
+  , defMod
+  -- * Parsing helpers
+  , Parser
+  , Args(..)
+  , pS
+  ) where
 
 import Data.List
 import GHC.Generics
 import Text.Megaparsec
 import Text.Megaparsec.Char
-import Data.Maybe
 import Data.Char
 import Data.Proxy
 import Data.Semigroup
-import Data.Either
 
 
+-- | Command-line arguments wrapper, used to avoid an orphan 'Stream'
+-- instance.
+newtype Args = Args [String]
+
+-- | Advances by one token.
 advance :: Pos -> SourcePos -> t -> SourcePos
-advance width (SourcePos n l c) t = SourcePos n l (c <> pos1)
+advance _ (SourcePos n l c) _ = SourcePos n l (c <> pos1)
 
-instance Stream [String] where
-  type Token [String] = String
-  type Tokens [String] = [String]
+-- | A list of strings (command-line arguments) stream.
+instance Stream Args where
+  type Token Args = String
+  type Tokens Args = [String]
   tokenToChunk Proxy = pure
   tokensToChunk Proxy = id
   chunkToTokens Proxy = id
@@ -31,32 +61,41 @@ instance Stream [String] where
   chunkEmpty Proxy = null
   advance1 Proxy = advance
   advanceN Proxy w = foldl' (advance w)
-  take1_ [] = Nothing
-  take1_ (t:ts) = Just (t, ts)
-  takeN_ n s
-    | n <= 0    = Just ([], s)
+  take1_ (Args []) = Nothing
+  take1_ (Args (t:ts)) = Just (t, Args ts)
+  takeN_ n (Args s)
+    | n <= 0    = Just ([], Args s)
     | null s    = Nothing
-    | otherwise = Just (splitAt n s)
-  takeWhile_ = span
+    | otherwise = Just (take n s, Args (drop n s))
+  takeWhile_ f (Args s) = (takeWhile f s, Args (dropWhile f s))
 
-type Parser = Parsec String [String]
+-- | Command-line arguments parser.
+type Parser = Parsec String Args
 
-pS :: Parsec String String a -> Parsec String [String] a
+-- | Applies a String parser to a single argument.
+pS :: Parsec String String a -> Parsec String Args a
 pS p = try $ do
   x <- token Right Nothing
   case parse p "argument" x of
     Left e -> fail $ show e
-    Right x -> pure x
+    Right x' -> pure x'
 
 
+-- | Name modifiers.
 data Modifiers = Modifiers { conNameMod :: String -> String
-                           , selNameMod :: String -> String }
+                           -- ^ Constructor name modifier.
+                           , selNameMod :: String -> String
+                           -- ^ Record selector name modifier.
+                           }
 
+-- | Default modifiers.
 defMod :: Modifiers
 defMod = Modifiers (map toLower) (("--" ++) . map toLower)
 
+
 -- Core classes
 
+-- | Arguments parser class.
 class ArgParser a where
   argParser :: Modifiers -> Parser a
   default argParser :: (Generic a, GArgParser (Rep a)) => Modifiers -> Parser a
@@ -65,6 +104,13 @@ class ArgParser a where
 class GArgParser f where
   gArgParser :: Modifiers -> Parser (f a)
 
+-- | Parses arguments.
+fromArgs :: ArgParser a => Modifiers -> [String] -> Either String a
+fromArgs m args = case parse (argParser m) "arguments" (Args args) of
+  Left err -> Left $ show err
+  Right x -> Right x
+
+-- | Arguments serializer class.
 class ToArgs a where
   toArgs :: Modifiers -> a -> [String]
   default toArgs :: (Generic a, GToArgs (Rep a)) => Modifiers -> a -> [String]
@@ -171,20 +217,20 @@ instance {-#OVERLAPPING#-}
 
 -- Constructors
 
-instance (GArgParser a, Constructor c) => GArgParser (C1 c a) where
+instance (GArgParser a) => GArgParser (C1 c a) where
   gArgParser m = M1 <$> gArgParser m
 
-instance (GToArgs a, Constructor c) => GToArgs (C1 c a) where
-  gToArgs m c@(M1 x) = gToArgs m x
+instance (GToArgs a) => GToArgs (C1 c a) where
+  gToArgs m (M1 x) = gToArgs m x
 
 
 -- Data types
 
-instance (GArgParser a, Datatype c) => GArgParser (D1 c a) where
+instance (GArgParser a) => GArgParser (D1 c a) where
   gArgParser m = M1 <$> gArgParser m
 
-instance (GToArgs a, Datatype c) => GToArgs (D1 c a) where
-  gToArgs m d@(M1 x) = gToArgs m x
+instance (GToArgs a) => GToArgs (D1 c a) where
+  gToArgs m (M1 x) = gToArgs m x
 
 
 -- Constraints and such
diff --git a/Example.hs b/Example.hs
index 9230d97..9f48024 100644
--- a/Example.hs
+++ b/Example.hs
@@ -1,9 +1,5 @@
 {-# LANGUAGE DeriveGeneric #-}
-
-module Main where
-
 import GHC.Generics
-import Text.Megaparsec
 import Coalpit
 
 data FooArgs = FooArgs { arg1 :: Int
@@ -28,10 +24,10 @@ instance ToArgs Input
 main :: IO ()
 main = do
   let val = Input { something = Nothing
-                  , fooBar = Just (Foo (FooArgs { arg1 = 1
-                                                , arg2 = "a string"}))
+                  , fooBar = Just (Foo FooArgs { arg1 = 1
+                                               , arg2 = "a string"})
                   , fooBar2 = Bar}
       args = toArgs defMod val
   print val
   print args
-  print $ parse (argParser defMod :: Parser Input) "test" args
+  print (fromArgs defMod args :: Either String Input)
diff --git a/coalpit.cabal b/coalpit.cabal
index 91e175a..dcf8b43 100644
--- a/coalpit.cabal
+++ b/coalpit.cabal
@@ -1,37 +1,34 @@
--- Initial coalpit.cabal generated by cabal init.  For further 
--- documentation, see http://haskell.org/cabal/users-guide/
-
 name:                coalpit
-version:             0.1.0.0
--- synopsis:            
--- description:         
+version:             0.1.0.1
+synopsis:            Command-line options parsing and printing
 license:             BSD3
 license-file:        LICENSE
 author:              defanor
 maintainer:          defanor@uberspace.net
--- copyright:           
 category:            Console
 build-type:          Simple
 extra-source-files:  ChangeLog.md
                    , Example.hs
                    , README.md
 cabal-version:       >=1.10
+tested-with:         GHC == 8.0.1, GHC == 8.0.2, GHC == 8.2.1
 
 library
   exposed-modules:     Coalpit
-  other-extensions:    TemplateHaskell, FlexibleInstances
   build-depends:       base >= 4.9 && < 5
                      , megaparsec >= 6.2 && < 7
   default-language:    Haskell2010
+  ghc-options:         -Wall
 
 test-suite test-coalpit
+  default-language:    Haskell2010
   type:                exitcode-stdio-1.0
   hs-source-dirs:      test
   main-is:             Test.hs
   build-depends:       base >= 4.9 && < 5
-                     , megaparsec >= 6.2 && < 7
                      , generic-random >= 1 && < 2
                      , tasty >= 0.12 && < 1
                      , tasty-quickcheck >= 0.9 && < 1
                      , tasty-travis >= 0.2 && < 1
                      , coalpit
+  ghc-options:         -Wall -Wno-unused-top-binds
diff --git a/test/Test.hs b/test/Test.hs
index 28d67ee..5002263 100644
--- a/test/Test.hs
+++ b/test/Test.hs
@@ -1,6 +1,5 @@
 {-# LANGUAGE DeriveGeneric #-}
 
-import Text.Megaparsec
 import GHC.Generics
 import Generic.Random
 import Test.Tasty
@@ -78,9 +77,9 @@ instance ArgParser NestedSum
 instance ToArgs NestedSum
 instance Arbitrary NestedSum where arbitrary = genericArbitraryU
 
-printAndParse :: (ArgParser a, ToArgs a, Eq a, Show a, Arbitrary a)
+printAndParse :: (ArgParser a, ToArgs a, Eq a)
               => Proxy a -> a -> Bool
-printAndParse _ r = Right r == parse (argParser defMod) "test" (toArgs defMod r)
+printAndParse _ r = Right r == fromArgs defMod (toArgs defMod r)
 
 mkTest :: (ArgParser a, ToArgs a, Eq a, Show a, Arbitrary a)
        => Proxy a -> String -> TestTree
@@ -89,6 +88,7 @@ mkTest p n = QC.testProperty ("id == parse . print for " ++ n) (printAndParse p)
 main :: IO ()
 main = travisTestReporter defaultConfig [] qcProps
 
+qcProps :: TestTree
 qcProps = testGroup "Quickcheck properties"
   [ mkTest (Proxy :: Proxy Basic) "Basic"
   , mkTest (Proxy :: Proxy WithLists) "WithLists"