code-builder (empty) → 0.1.2.1

raw patch · 8 files changed

+446/−0 lines, 8 filesdep +basedep +containerssetup-changed

Dependencies added: base, containers

Files

• LICENSE +30/−0
• Setup.hs +2/−0
• code-builder.cabal +26/−0
• src/Code/Build.hs +158/−0
• src/Code/Build/Haskell.hs +45/−0
• src/Code/Build/JavaScript.hs +55/−0
• src/Code/Build/PHP.hs +64/−0
• src/Code/Build/Ruby.hs +66/−0

@@ -0,0 +1,30 @@+Copyright (c) 2014, Silk++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 Silk 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.

@@ -0,0 +1,2 @@+import Distribution.Simple+main = defaultMain

@@ -0,0 +1,26 @@+Name:                code-builder+Version:             0.1.2.1+Synopsis:            Simple system for generating code.+Description:         Simple system for generating code.+License:             BSD3+License-file:        LICENSE+Author:              Silk+Maintainer:          code@silk.co+Category:            Data+Build-type:          Simple+Cabal-version:       >=1.6++Library+  Hs-Source-Dirs:    src+  Exposed-Modules:   Code.Build+                     Code.Build.JavaScript+                     Code.Build.Haskell+                     Code.Build.PHP+                     Code.Build.Ruby+  Build-Depends:     base == 4.*+                   , containers >= 0.3 && < 0.6+  Ghc-Options:       -Wall++Source-repository head+  Type:              Git+  Location:          https://github.com/silkapp/rest.git

@@ -0,0 +1,158 @@+{-# LANGUAGE OverlappingInstances, TypeSynonymInstances, FlexibleInstances, UndecidableInstances #-}+module Code.Build where++import Data.List++-- | Representation of code, each string represents a line+newtype Code = Code { unCode :: [String] }++showCode :: Code -> String+showCode = intercalate "\n" . unCode++-- | Type class for lifting data structures into code+class Codeable a where+  code :: a -> Code++instance Codeable Code where+  code = id++instance Codeable String where+  code = Code . (:[])++instance Codeable a => Codeable (Maybe a) where+  code = maybe noCode code++instance Show a => Codeable a where+  code = Code . (:[]) . show++class CodeList a where+  codeList :: a -> [Code]++instance Codeable a => CodeList a where+  codeList = (:[]) . code++instance Codeable a => CodeList [a] where+  codeList = map code++-- * Functions on code+noCode :: Code+noCode = Code []++line :: Code+line = Code [""]++isNull :: Codeable a => a -> Bool+isNull = null . unCode . code++numLines :: CodeList a => a -> Int+numLines = length . unCode . mkStack . codeList++singleLine :: CodeList a => a -> Bool+singleLine = (==1) . numLines++indent :: Codeable a => Int -> a -> Code+indent n = Code . map (replicate n ' ' ++) . unCode . code++surround :: Codeable a => String -> String -> a -> Code+surround l r a = l <+> a <+> r++parenthesis :: Codeable a => a -> Code+parenthesis = surround "(" ")"++accolades :: Codeable a => a -> Code+accolades = surround "{" "}"++square :: Codeable a => a -> Code+square = surround "[" "]"++align :: Codeable a => a -> Code+align v = Code . map addWhite . unCode . code $ v+    where addWhite l = l ++ replicate (codeWidth v - length l) ' '++codeWidth :: Codeable a => a -> Int+codeWidth = foldr max 0 . map length . unCode . code++codeLines :: Codeable a => a -> [Code]+codeLines = map (Code . (:[])) . unCode . code++many :: Codeable a => a -> Code+many = Code . concat . repeat . unCode . code++mkSequence :: Codeable a => [a] -> Code+mkSequence = foldl (<+>) noCode . map code++mkStack :: Codeable a => [a] -> Code+mkStack = foldl (<->) noCode . map code++interleave :: (Codeable a, CodeList l) => a -> l -> Code+interleave c l =+  case codeList l of+    []      -> noCode+    [x]     -> x+    (x: xs) -> x <+> code c <+> interleave c xs++-- * Combinators for building blocks of code+infixl 4 <+>+infixl 4 <++>+infixl 4 <+|++infixl 3 |>+<|+infixl 3 |><|+infixl 3 ><+infixl 3 |><+infixl 3 ><|++infixl 2 <->++-- | Join two blocks line by line, in the way of inner join, so both lines have to be present.+(|><|) :: (Codeable a, Codeable b) => a -> b -> Code+a |><| b = Code $ zipWith (++) ca cb+        where ca = unCode . code $ a+              cb = unCode . code $ b++-- | Join two blocks line by line, in the way of outer join, so both missing lines are discarded.+(><) :: (Codeable a, Codeable b) => a -> b -> Code+a >< b = a <-> mkStack (replicate ((numLines (code b) - numLines (code a)) `max` 0) line) |><| b <-> mkStack (replicate ((numLines (code a) - numLines (code b)) `max` 0) line)++-- | Left outer-join+(|><) :: (Codeable a, Codeable b) => a -> b -> Code+a |>< b = a <-> mkStack (replicate ((numLines (code b) - numLines (code a)) `max` 0) line) |><| b++-- | Right outer-join+(><|) :: (Codeable a, Codeable b) => a -> b -> Code+a ><| b = a |><| b <-> mkStack (replicate ((numLines (code a) - numLines (code b)) `max` 0) line)++-- | Sequencing. Place the second block after the last line of the first block. Aligns the second block+(<+>) :: (Codeable a, Codeable b) => a -> b -> Code+a <+> b =+  case ca of+    [] -> code b+    ls -> case cb of+            []        -> code a+            (bl: bls) -> Code $ init ls ++ [last ls ++ bl] ++ bls+  where ca = unCode . code $ a+        cb = unCode . code $ b++-- | Same as <++> but with space+(<++>) :: (Codeable a, Codeable b) => a -> b -> Code+a <++> b = a <+> " " <+> b++-- | Place the second block after the last line of the first block. Aligns the second block+(<+|) :: (Codeable a, Codeable b) => a -> b -> Code+a <+| b =+  case ca of+    [] -> code b+    ls -> case cb of+            []        -> code a+            (bl: bls) -> Code $ init ls ++ [last ls ++ bl] ++ map (replicate (length $ last ls) ' ' ++) bls+  where ca = unCode . code $ a+        cb = unCode . code $ b++-- | Combination of join and sequence. The code blocks in the second argument are sequenced with the first argument.+(|>+<|) :: (Codeable a, CodeList b) => a -> b -> Code+a |>+<| b = mkStack $ zipWith (<+|) (codeLines a) (codeList b)++-- | Place two pieces of code under each other+(<->) :: (Codeable a, Codeable b) => a -> b -> Code+a <-> b = Code $ (unCode $ code a) ++ (unCode $ code b)+

@@ -0,0 +1,45 @@+module Code.Build.Haskell where++import Code.Build+import Data.List++record :: [(String, Code)] -> Code+record []    = code "{}"+record items = ("{ " <-> many ", ") |><| mkStack (map fst items) |><| many " = " |>+<| map snd items <-> "}"++block :: CodeList a => a -> Code+block = mkStack . codeList++hsModule :: CodeList a => String -> a -> Code+hsModule name c = "module" <++> name <++> "where" <-> block c++hsType :: [String] -> String+hsType = intercalate " -> "++hsDecl :: Codeable a => String -> [String] -> a -> Code+hsDecl n pars c | singleLine (code c) = n <++> intercalate " " pars <++> "= " <+| c+                | otherwise = n <++> intercalate " " pars <++> "=" <-> indent 2 c++function :: String -> String -> Code+function n t = n <++> "::" <++> t++hsLet :: (CodeList a, Codeable b) => a -> b -> Code+hsLet decls f = ("let " <+| block decls) <-> "in " <+| code f++hsArray :: CodeList a => a -> Code+hsArray = surround "[" "]" . interleave ", "++hsTuple :: CodeList a => a -> Code+hsTuple = parenthesis . interleave ", "++hsData :: String -> [String] -> Code+hsData n cons = "data" <++> n <+| (" = " <-> many " | ") |><| block cons++string :: Codeable a => a -> Code+string = surround "\"" "\""++infix 2 .=.++(.=.) :: Codeable b => String -> b -> Code+v .=. c | singleLine (code c) = v <+> " = " <+| c+        | otherwise           = v <+> " =" <-> indent 2 c

@@ -0,0 +1,55 @@+module Code.Build.JavaScript where++import Code.Build+import Data.List++jsObject :: [(String, Code)] -> Code+jsObject [] = code "{}"+jsObject items = ("{ " <-> many ", ") |><| mkStack (map fst items) |><| many ": " |>+<| map snd items <-> "}"++statements :: CodeList a => a -> Code+statements = mkStack . codeList++block :: CodeList a => a -> Code+block c = "{" <-> indent 2 (statements c) <-> "}"++jsIf :: (Codeable a, CodeList b) => a -> b -> Code+jsIf cond blk = "if" <++> parenthesis cond <-> block blk++jsElse :: CodeList a => a -> Code+jsElse blk = "else" <-> block blk++for :: (Codeable a, CodeList b) => a -> b -> Code+for cond blk = "for" <++> parenthesis cond <-> block blk++function :: CodeList a => [String] -> a -> Code+function pars body = "function" <++> parenthesis (intercalate ", " pars) <-> block body++functionDecl :: CodeList a => String -> [String] -> a -> Code+functionDecl name pars body = "function" <++> name <++> parenthesis (intercalate ", " pars) <-> block body++call :: CodeList a => String -> a -> Code+call func as | all singleLine (codeList as) = func <+> parenthesis (interleave ", " $ codeList as)+             | otherwise                    = func <+| (("( " <-> many ", ") |>+<| as) <+> ")"++proc :: CodeList a => String -> a -> Code+proc f a = call f a <+> ";"++ret :: Codeable a => a -> Code+ret a = "return " <+| a <+> ";"++string :: Codeable a => a -> Code+string = surround "\"" "\""++new :: Codeable a => String -> a ->  Code+new clas c = "new" <++> clas <+| parenthesis c++var :: Codeable a => String -> a -> Code+var n c | singleLine (code c) = "var " <+> n <+> " = " <+| c <+> ";"+        | otherwise           = "var " <+> n <+> " =" <-> indent 2 c <+> ";"++infix 2 .=.++(.=.) :: Codeable b => String -> b -> Code+v .=. c | singleLine (code c) = v <+> " = " <+| c <+> ";"+        | otherwise           = v <+> " =" <-> indent 2 c <+> ";"

@@ -0,0 +1,64 @@+module Code.Build.PHP where++import Code.Build+import Data.List++hashmap :: [(String, Code)] -> Code+hashmap = call "array" . map (\(a,b) -> a <++> "=>" <++> b)++statements :: CodeList a => a -> Code+statements = mkStack . codeList++block :: CodeList a => a -> Code+block c = "{" <-> indent 2 (statements c) <-> "}"++phpIf :: (Codeable a, CodeList b) => a -> b -> Code+phpIf cond blk = "if" <++> parenthesis cond <-> block blk++phpElse :: CodeList a => a -> Code+phpElse blk = "else" <-> block blk++for :: (Codeable a, CodeList b) => a -> b -> Code+for cond blk = "for" <++> parenthesis cond <-> block blk++php :: CodeList a => a -> Code+php a = "<?php" <-> statements a <-> "?>"++phpClass :: CodeList a => String -> a -> Code+phpClass name c = "class" <++> name <-> block c++protected :: Codeable a => String -> a -> Code+protected s c = "protected" <++> var s c++function :: CodeList a => [String] -> a -> Code+function pars body = "function" <++> parenthesis (intercalate ", " pars) <-> block body++functionDecl :: CodeList a => String -> [String] -> a -> Code+functionDecl name pars body = "function" <++> name <++> parenthesis (intercalate ", " pars) <-> block body++call :: CodeList a => String -> a -> Code+call func as | all singleLine (codeList as) = func <+> parenthesis (interleave ", " $ codeList as)+             | otherwise                    = func <+| (("( " <-> many ", ") |>+<| as) <+> ")"++proc :: CodeList a => String -> a -> Code+proc f a = call f a <+> ";"++ret :: Codeable a => a -> Code+ret a = "return " <+| a <+> ";"++string :: Codeable a => a -> Code+string = surround "\"" "\""++new :: Codeable a => String -> a ->  Code+new clas c = "new" <++> clas <+| parenthesis c++var :: Codeable a => String -> a -> Code+var n c | isNull (code c)     = "$" <+> n <+> ";"+var n c | singleLine (code c) = "$" <+> n <+> " = " <+| c <+> ";"+        | otherwise           = "$" <+> n <+> " =" <-> indent 2 c <+> ";"++infix 2 .=.++(.=.) :: Codeable b => String -> b -> Code+v .=. c | singleLine (code c) = "$" <+> v <+> " = " <+| c <+> ";"+        | otherwise           = "$" <+> v <+> " =" <-> indent 2 c <+> ";"

@@ -0,0 +1,66 @@+module Code.Build.Ruby where++import Code.Build+import Data.List++hashmap :: [(String, Code)] -> Code+hashmap [] = code "{}"+hashmap items = ("{ " <-> many ", ") |><| mkStack (map ((':': ) . fst) items) |><| many " => " |>+<| map snd items <-> "}"++statements :: CodeList a => a -> Code+statements = mkStack . codeList++block :: CodeList a => a -> Code+block c = indent 2 (statements c)++endBlock :: CodeList a => a -> Code+endBlock c = indent 2 (statements c) <-> "end"++rbIf :: (Codeable a, CodeList b) => a -> b -> Code+rbIf cond blk = "if" <++> parenthesis cond <-> endBlock blk++rbIf_ :: (Codeable a, CodeList b) => a -> b -> Code+rbIf_ cond blk = "if" <++> parenthesis cond <-> block blk++rbElsIf :: (Codeable a, CodeList b) => a -> b -> Code+rbElsIf cond blk = "elsif" <++> parenthesis cond <-> endBlock blk++rbElsIf_ :: (Codeable a, CodeList b) => a -> b -> Code+rbElsIf_ cond blk = "elsif" <++> parenthesis cond <-> block blk++rbElse :: CodeList b => b -> Code+rbElse blk = "else" <-> endBlock blk++--rbIfElse :: CodeList a => a -> Code+--rbIfElse blk = "else" <-> block blk++rbModule :: CodeList a => String -> a -> Code+rbModule name c = "module" <++> name <-> endBlock c++rbClass :: CodeList a => String -> a -> Code+rbClass name c = "class" <++> name <-> endBlock c++require :: String -> Code+require name = "require" <++> string name++function :: CodeList a => String -> [String] -> a -> Code+function name pars body = "def" <++> name <++> parenthesis (intercalate ", " pars) <-> endBlock body++call :: CodeList a => String -> a -> Code+call func as | all singleLine (codeList as) = func <+> parenthesis (interleave ", " $ codeList as)+             | otherwise                    = func <+| (("( " <-> many ", ") |>+<| as) <+> ")"++ret :: Codeable a => a -> Code+ret a = "return " <+| a++string :: Codeable a => a -> Code+string = surround "'" "'"++new :: CodeList a => String -> a ->  Code+new clas pars = clas ++ ".new" <+| parenthesis (interleave ", " $ codeList pars)++infix 2 .=.++(.=.) :: Codeable b => String -> b -> Code+v .=. c | singleLine (code c) = v <+> " = " <+| c+        | otherwise           = v <+> " =" <-> indent 2 c