From 4beea4536a36322e15665de74c96926f0cf5fe7b Mon Sep 17 00:00:00 2001
From: defanor <defanor@uberspace.net>
Date: Fri, 25 Nov 2016 06:35:55 +0300
Subject: Initial commit

---
 ChangeLog.md  |  5 ++++
 Coalpit.hs    | 88 +++++++++++++++++++++++++++++++++++++++++++++++++++++++++++
 Example.hs    | 27 ++++++++++++++++++
 LICENSE       | 30 ++++++++++++++++++++
 README.md     | 51 ++++++++++++++++++++++++++++++++++
 coalpit.cabal | 31 +++++++++++++++++++++
 6 files changed, 232 insertions(+)
 create mode 100644 ChangeLog.md
 create mode 100644 Coalpit.hs
 create mode 100644 Example.hs
 create mode 100644 LICENSE
 create mode 100644 README.md
 create mode 100644 coalpit.cabal

diff --git a/ChangeLog.md b/ChangeLog.md
new file mode 100644
index 0000000..332ff71
--- /dev/null
+++ b/ChangeLog.md
@@ -0,0 +1,5 @@
+# Revision history for coalpit
+
+## 0.1.0.0  -- 2016-11-24
+
+* A prototype.
diff --git a/Coalpit.hs b/Coalpit.hs
new file mode 100644
index 0000000..f36f581
--- /dev/null
+++ b/Coalpit.hs
@@ -0,0 +1,88 @@
+{-# LANGUAGE FlexibleInstances #-}
+{-# LANGUAGE TemplateHaskell #-}
+
+module Coalpit where
+
+import Language.Haskell.TH
+import Data.Char
+import Data.List
+
+
+class Args a where
+  toArgs :: a -> [String]
+  fromArgs :: [String] -> (a, [String])
+
+instance {-#OVERLAPPING#-} Args String where
+  toArgs = pure . show
+  fromArgs (x:xs) = (read x, xs)
+
+instance Args Int where
+  toArgs = pure . show
+  fromArgs (x:xs) = (read x, xs)
+
+instance Args Bool where
+  toArgs True = ["t"]
+  toArgs False = ["f"]
+  fromArgs ("t":xs) = (True, xs)
+  fromArgs ("f":xs) = (False, xs)
+
+instance Args a => Args (Maybe a) where
+  toArgs Nothing = ["n"]
+  toArgs (Just x) = "j" : toArgs x
+  fromArgs ("n":xs) = (Nothing, xs)
+  fromArgs ("j":xs) = let (y, ys) = fromArgs xs in (Just y, ys)
+
+instance Args a => Args [a] where
+  toArgs = pure . intercalate "," . concatMap toArgs
+  fromArgs (arg:args) = (map (fst . fromArgs . pure) $ splitOn ',' arg, args)
+
+splitOn :: Eq a => a -> [a] -> [[a]]
+splitOn sep l = case break (== sep) l of
+  (x, []) -> [x]
+  (x, _:xs) -> x : splitOn sep xs
+
+printCon :: Name -> String
+printCon = map toLower . reverse . takeWhile (/= '.') . reverse . show
+
+printClause :: Con -> Q Clause
+printClause (NormalC cn bts) = do
+  let ts = map snd bts
+      vars = (map (mkName . ("x_" ++) . show) [1..length ts])
+      args = map (\v -> AppE (VarE 'toArgs) (VarE v)) vars
+  pure $ Clause [ConP cn (map VarP vars)]
+    (NormalB (AppE (VarE 'concat) $ ListE
+               (ListE [LitE (StringL $ printCon cn)] : args)))
+    []
+
+parseClause :: Con -> Q Clause
+parseClause (NormalC cn bts) = do
+  let ts = map snd bts
+      vars = map (mkName . ("x_" ++) . show) [1..length ts]
+      vals = map (\x -> mkName (show x ++ "_val")) vars
+      fin = (TupE [foldl AppE (ConE cn) (map VarE vals)
+                   , VarE (mkName $ (if length vars > 0
+                                     then show (last vars)
+                                     else "xs") ++ "_rest")
+                   ])
+  pure $ Clause [InfixP (LitP (StringL $ printCon cn))
+                 (mkName ":")
+                 (VarP (mkName "xs_rest"))]
+    (NormalB $ foldr parseArg fin (zip (mkName "xs" : vars) vars))
+    []
+  where
+    parseArg :: (Name, Name) -> Exp -> Exp
+    parseArg (np, nc) e = LetE
+      [ValD (TupP [VarP (mkName (show nc ++ "_val")),
+                    VarP (mkName (show nc ++ "_rest"))])
+        (NormalB $ AppE (VarE 'fromArgs) (VarE (mkName (show np ++ "_rest"))))
+        []]
+      e
+
+deriveArgs :: Name -> Q [Dec]
+deriveArgs ty = do
+  let var = mkName "x"
+  (TyConI d@(DataD _ nm tyVars mk cs _)) <- reify ty
+  to <- mapM printClause cs
+  from <- mapM parseClause cs
+  pure [InstanceD Nothing [] (AppT (ConT ''Args) (ConT ty))
+        [FunD 'toArgs to, FunD 'fromArgs from]]
diff --git a/Example.hs b/Example.hs
new file mode 100644
index 0000000..20cae00
--- /dev/null
+++ b/Example.hs
@@ -0,0 +1,27 @@
+{-# LANGUAGE TemplateHaskell #-}
+
+module Main where
+
+import Coalpit
+import Language.Haskell.TH
+import Data.List
+
+data Y = Foo Bool Int
+       | Bar Int
+       | Baz
+  deriving (Show)
+
+data X = X String (Maybe Int) (Maybe [Int]) Y Y String
+  deriving (Show)
+
+$(deriveArgs ''Y)
+$(deriveArgs ''X)
+
+main :: IO ()
+main = do
+  let val = X "test" Nothing (Just [1,2,3]) (Foo True 1) Baz "end"
+      args = toArgs val
+  print val
+  putStrLn $ intercalate " " args
+  print (fromArgs args :: (X, [String]))
+  print (fromArgs (args ++ ["additional", "args"]) :: (X, [String]))
diff --git a/LICENSE b/LICENSE
new file mode 100644
index 0000000..bcbd251
--- /dev/null
+++ b/LICENSE
@@ -0,0 +1,30 @@
+Copyright (c) 2016, defanor
+
+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 defanor 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
index 0000000..63db06d
--- /dev/null
+++ b/README.md
@@ -0,0 +1,51 @@
+# Coalpit
+
+Coalpit is a library for building command-line program
+interfaces. They are like command-line user interfaces, but for
+programs.
+
+Given a type, it derives instances to print and parse it as
+command-line arguments.
+
+The goal is to
+faciliate
+[the KISS principle](https://en.wikipedia.org/wiki/KISS_principle)
+preservation for interfaces between system components in certain
+(rather [unixy](https://en.wikipedia.org/wiki/Unix_philosophy))
+architectures. Described in more detail in
+the
+[command-line program interface](https://defanor.uberspace.net/notes/command-line-program-interface.html) note.
+
+Not production-ready yet, merely a prototype.
+
+
+## Example
+
+There is an example in `Example.hs`, but here are some bits:
+
+```haskell
+data Y = Foo Bool Int
+       | Bar Int
+       | Baz
+data X = X String (Maybe Int) (Maybe [Int]) Y Y String
+$(deriveArgs ''Y)
+$(deriveArgs ''X)
+```
+
+`toArgs` serializes data into arguments, and `fromArgs` deserializes
+it: `X "test" Nothing (Just [1,2,3]) (Foo True 1) Baz "end"` ↔ `x
+"test" n j 1,2,3 foo t 1 baz "end"`.
+
+
+## TODO
+
+What it currently lacks, but what should be done, roughly in that
+order:
+
+* Proper parsing: use optparse-applicative, Parsec, or a custom
+  parser, but something with error handling and more flexible.
+* Named arguments (via records), not just positional ones.
+* Optional arguments: once the named ones will be there, `Maybe a`
+  could be handled nicer.
+* Help messages.
+* Documentation.
diff --git a/coalpit.cabal b/coalpit.cabal
new file mode 100644
index 0000000..4625ecf
--- /dev/null
+++ b/coalpit.cabal
@@ -0,0 +1,31 @@
+-- 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:         
+license:             BSD3
+license-file:        LICENSE
+author:              defanor
+maintainer:          defanor@uberspace.net
+-- copyright:           
+category:            Console
+build-type:          Simple
+extra-source-files:  ChangeLog.md
+cabal-version:       >=1.10
+
+executable coalpit-example
+  main-is:             Example.hs
+  -- other-modules:       
+  other-extensions:    TemplateHaskell
+  build-depends:       base >=4.9 && <4.10
+                     , template-haskell >=2.11 && <2.12
+  default-language:    Haskell2010
+
+library
+  exposed-modules:     Coalpit
+  other-extensions:    TemplateHaskell, FlexibleInstances
+  build-depends:       base >=4.9 && <4.10
+                     , template-haskell >=2.11 && <2.12
+  default-language:    Haskell2010
-- 
cgit v1.2.3