summaryrefslogtreecommitdiffstats
diff options
context:
space:
mode:
authordefanor <defanor@uberspace.net>2016-11-25 06:35:55 +0300
committerdefanor <defanor@uberspace.net>2016-11-25 06:35:55 +0300
commit4beea4536a36322e15665de74c96926f0cf5fe7b (patch)
tree3fbf95944351b0ceaf4c925715ee9bec4069fb7d
downloadcoalpit-4beea4536a36322e15665de74c96926f0cf5fe7b.zip
coalpit-4beea4536a36322e15665de74c96926f0cf5fe7b.tar.gz
coalpit-4beea4536a36322e15665de74c96926f0cf5fe7b.tar.bz2
Initial commit
-rw-r--r--ChangeLog.md5
-rw-r--r--Coalpit.hs88
-rw-r--r--Example.hs27
-rw-r--r--LICENSE30
-rw-r--r--README.md51
-rw-r--r--coalpit.cabal31
6 files changed, 232 insertions, 0 deletions
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