Documentation

src/Fay/Compiler/Exp.hs

@@ -2,14 +2,14 @@
 {-# LANGUAGE OverloadedStrings #-}
 {-# LANGUAGE MultiParamTypeClasses #-}
 
--- | Compile expressions
+-- | Compile expressions.
 
 module Fay.Compiler.Exp where
 
 import Fay.Compiler.Misc
 import Fay.Compiler.Pattern
 import Fay.Compiler.Print
-import Fay.Compiler.FFI             (ffiFun)
+import Fay.Compiler.FFI             (compileFFIExp)
 import Fay.Types
 
 import Control.Applicative
@@ -46,12 +46,12 @@ compileExp exp =
     EnumFromThen a b              -> compileEnumFromThen a b
     EnumFromThenTo a b z          -> compileEnumFromThenTo a b z
     RecConstr name fieldUpdates   -> compileRecConstr name fieldUpdates
-    RecUpdate rec  fieldUpdates   -> updateRec rec fieldUpdates
+    RecUpdate rec  fieldUpdates   -> compileRecUpdate rec fieldUpdates
     ListComp exp stmts            -> compileExp =<< desugarListComp exp stmts
     ExpTypeSig srcloc exp sig     ->
       case ffiExp exp of
         Nothing -> compileExp exp
-        Just formatstr -> ffiFun srcloc Nothing formatstr sig
+        Just formatstr -> compileFFIExp srcloc Nothing formatstr sig
 
     exp -> throwError (UnsupportedExpression exp)
 
@@ -86,6 +86,7 @@ compileApp exp1@(Var q) exp2 =
 compileApp exp1 exp2 =
   compileApp' exp1 exp2
 
+-- | Helper for compileApp.
 compileApp' :: Exp -> Exp -> Compile JsExp
 compileApp' exp1 exp2 = do
   flattenApps <- config configFlattenApps
@@ -308,8 +309,9 @@ compileRecConstr name fieldUpdates = do
         -- I couldn't find a code that generates (FieldUpdate (FieldPun ..))
         updateStmt _ u = error ("updateStmt: " ++ show u)
 
-updateRec :: Exp -> [FieldUpdate] -> Compile JsExp
-updateRec rec fieldUpdates = do
+-- | Compile a record update.
+compileRecUpdate :: Exp -> [FieldUpdate] -> Compile JsExp
+compileRecUpdate rec fieldUpdates = do
     record <- force <$> compileExp rec
     let copyName = UnQual (Ident "$_record_to_update")
         copy = JsVar (JsNameVar copyName)

src/Fay/Compiler/FFI.hs

@@ -3,13 +3,13 @@
 {-# LANGUAGE ViewPatterns      #-}
 {-# OPTIONS -Wall #-}
 
--- | Compiling the FFI support.
+-- | Compile FFI definitions.
 
 module Fay.Compiler.FFI
   (emitFayToJs
   ,emitJsToFay
   ,compileFFI
-  ,ffiFun
+  ,compileFFIExp
   ,jsToFayHash
   ,fayToJsHash
   ) where
@@ -43,7 +43,7 @@ compileFFI :: SrcLoc -- ^ Location of the original FFI decl.
 compileFFI srcloc name formatstr sig =
   -- substitute newtypes with their child types before calling
   -- real compileFFI
-  compileFFI' srcloc name formatstr =<< rmNewtys sig
+  compileFFI' =<< rmNewtys sig
 
   where rmNewtys :: Type -> Compile Type
         rmNewtys (TyForall b c t) = TyForall b c <$> rmNewtys t
@@ -61,14 +61,15 @@ compileFFI srcloc name formatstr sig =
         rmNewtys (TyInfix t1 q t2)= flip TyInfix q <$> rmNewtys t1 <*> rmNewtys t2
         rmNewtys (TyKind t k)     = flip TyKind k <$> rmNewtys t
 
-compileFFI' :: SrcLoc -> Name -> String -> Type -> Compile [JsStmt]
-compileFFI' srcloc name formatstr sig = do
-  fun <- ffiFun srcloc (Just name) formatstr sig
-  stmt <- bindToplevel True name fun
-  return [stmt]
+        compileFFI' :: Type -> Compile [JsStmt]
+        compileFFI' sig' = do
+          fun <- compileFFIExp srcloc (Just name) formatstr sig'
+          stmt <- bindToplevel True name fun
+          return [stmt]
 
-ffiFun :: SrcLoc -> Maybe Name -> String -> Type -> Compile JsExp
-ffiFun srcloc nameopt formatstr sig = do
+-- | Compile an FFI expression (also used when compiling top level definitions).
+compileFFIExp :: SrcLoc -> Maybe Name -> String -> Type -> Compile JsExp
+compileFFIExp srcloc nameopt formatstr sig = do
   let name = fromMaybe "<exp>" nameopt
   inner <- formatFFI srcloc formatstr (zip params funcFundamentalTypes)
   case JS.parse JS.expression (prettyPrint name) (printJSString (wrapReturn inner)) of
@@ -336,13 +337,14 @@ formatFFI srcloc formatstr args = go formatstr where
 explodeFields :: [([a], t)] -> [(a, t)]
 explodeFields = concatMap $ \(names,typ) -> map (,typ) names
 
+-- | Generate Fay→JS encoding.
 fayToJsHash :: [(String, JsExp)] -> [JsStmt]
 fayToJsHash cases = [JsExpStmt $ JsApp (JsName $ JsBuiltIn "objConcat") [JsName $ JsBuiltIn "fayToJsHash", JsObj cases]]
 
+-- | Generate JS→Fay decoding.
 jsToFayHash :: [(String, JsExp)] -> [JsStmt]
 jsToFayHash cases = [JsExpStmt $ JsApp (JsName $ JsBuiltIn "objConcat") [JsName $ JsBuiltIn "jsToFayHash", JsObj cases]]
 
-
 -- | Make a JS→Fay decoder.
 emitJsToFay ::  Name -> [TyVarBind] -> [([Name], BangType)] -> Compile ()
 emitJsToFay name tyvars (explodeFields -> fieldTypes) = do

src/Fay/Compiler/GADT.hs

@@ -1,4 +1,8 @@
-module Fay.Compiler.GADT(convertGADT) where
+-- | Convert GADTs into normal data types.
+
+module Fay.Compiler.GADT
+  (convertGADT
+  ) where
 
 import           Language.Haskell.Exts hiding (name, binds)
 

src/Fay/Compiler/InitialPass.hs

@@ -1,5 +1,7 @@
 {-# LANGUAGE OverloadedStrings #-}
 
+-- | Preprocessing collecting names, data types, newtypes, imports, and exports
+-- for all modules recursively.
 module Fay.Compiler.InitialPass
   (initialPass
   ) where
@@ -22,7 +24,7 @@ import           Language.Haskell.Exts.Parser
 import           Language.Haskell.Exts.Syntax
 import           Prelude hiding (mod, read)
 
-
+-- | Preprocess and collect all information needed during code generation.
 initialPass :: Module -> Compile ()
 initialPass (Module _ mod _ Nothing exports imports decls) =
   withModuleScope $ do

src/Fay/Compiler/ModuleScope.hs

@@ -110,6 +110,7 @@ envPrimOpsMap = M.fromList
   , (Symbol "||",    Qual (ModuleName "Fay$") (Ident "or"))
   ]
 
+-- | Lookup a primop that was resolved to a Prelude definition.
 findPrimOp :: QName -> Maybe QName
 findPrimOp (Qual (ModuleName "Prelude") s) = M.lookup s envPrimOpsMap
 findPrimOp _ = Nothing

src/Fay/Compiler/Pattern.hs

@@ -101,6 +101,7 @@ compilePAsPat exp name pat body = do
   p <- compilePat exp pat body
   return $ JsVar (JsNameVar $ UnQual name) exp : p
 
+-- | Compile a pattern match on a newtype.
 compileNewtypePat :: [Pat] -> JsExp -> [JsStmt] -> Compile [JsStmt]
 compileNewtypePat [pat] exp body = compilePat exp pat body
 compileNewtypePat ps _ _ = error $ "compileNewtypePat: Should be impossible (this is a bug). Got: " ++ show ps

src/Fay/Compiler/Print.hs

@@ -130,6 +130,7 @@ instance Printable JsStmt where
   printJS (JsMappedVar _ name expr) =
     "var " +> name +> " = " +> expr +> ";" +> newline
 
+-- | Print a module path.
 instance Printable ModulePath where
   printJS (unModulePath -> l) = write $ intercalate "." l
 
@@ -205,12 +206,12 @@ instance Printable JsExp where
   printJS (JsOr a b) =
       printJS a +> "||" +> printJS b
 
+-- | Unqualify a JsName.
 ident :: JsName -> JsName
 ident n = case n of
   JsConstructor (Qual _ s) -> JsNameVar $ UnQual s
   a -> a
 
-
 -- | Print one of the kinds of names.
 instance Printable JsName where
   printJS name =
@@ -227,11 +228,13 @@ instance Printable JsName where
       JsParametrizedType  -> write "type"
       JsModuleName (ModuleName m) -> write m
 
+-- | Print a constructor name given a QName.
 printCons :: QName -> Printer ()
 printCons (UnQual n) = printConsName n
 printCons (Qual (ModuleName m) n) = printJS m +> "." +> printConsName n
 printCons (Special _) = error "qname2String Special"
 
+-- | Print a constructor name given a Name. Helper for printCons.
 printConsName :: Name -> Printer ()
 printConsName n = write "_" >> printJS n
 

src/Fay/Compiler/QName.hs

@@ -1,3 +1,5 @@
+-- | Extras for haskell-src-exts names.
+
 module Fay.Compiler.QName where
 
 import Language.Haskell.Exts.Syntax

src/Fay/Types.hs

@@ -88,12 +88,16 @@ data CompileConfig = CompileConfig
   , configBasePath           :: Maybe FilePath             -- ^ Custom source location for fay-base
   } deriving (Show)
 
+-- | The name of a module split into a list for code generation.
 newtype ModulePath = ModulePath { unModulePath :: [String] }
   deriving (Eq, Ord, Show)
 
+-- | Construct the complete ModulePath from a ModuleName.
 mkModulePath :: ModuleName -> ModulePath
 mkModulePath (ModuleName m) = ModulePath . splitOn "." $ m
 
+-- | Construct intermediate module paths from a ModuleName.
+-- mkModulePaths "A.B" => [["A"], ["A","B"]]
 mkModulePaths :: ModuleName -> [ModulePath]
 mkModulePaths (ModuleName m) = map ModulePath . tail . inits . splitOn "." $ m
 
@@ -143,9 +147,11 @@ data CompileReader = CompileReader
 faySourceDir :: IO FilePath
 faySourceDir = fmap (takeDirectory . takeDirectory . takeDirectory) (getDataFileName "src/Language/Fay/Stdlib.hs")
 
+-- | Add a ModulePath to CompileState, meaning it has been printed.
 addModulePath :: ModulePath -> CompileState -> CompileState
 addModulePath mp cs = cs { stateJsModulePaths = mp `S.insert` stateJsModulePaths cs }
 
+-- | Has this ModulePath been added/printed?
 addedModulePath :: ModulePath -> CompileState -> Bool
 addedModulePath mp CompileState{..} = mp `S.member` stateJsModulePaths
 
@@ -158,13 +164,15 @@ addCurrentExport q cs =
     qnames = maybe (S.singleton q) (S.insert q)
            $ M.lookup (stateModuleName cs) (_stateExports cs)
 
--- | Get all of the exported identifiers for the current module.
+-- | Get all exports for the current module.
 getCurrentExports :: CompileState -> Set QName
 getCurrentExports cs = getExportsFor (stateModuleName cs) cs
 
+-- | Get exports from the current module originating from other modules.
 getNonLocalExports :: CompileState -> Set QName
 getNonLocalExports st = S.filter ((/= Just (stateModuleName st)) . qModName) . getCurrentExportsWithoutNewtypes $ st
 
+-- | Get all exports from the current module except newtypes.
 getCurrentExportsWithoutNewtypes :: CompileState -> Set QName
 getCurrentExportsWithoutNewtypes cs = excludeNewtypes cs $ getCurrentExports cs
   where

src/System/Directory/Extra.hs

@@ -1,10 +1,11 @@
-
+-- | Extra directory functions.
 module System.Directory.Extra where
 
 import Control.Monad (forM)
 import System.Directory (doesDirectoryExist, getDirectoryContents)
 import System.FilePath ((</>))
 
+-- | Get all files in a folder and its subdirectories.
 -- Taken from Real World Haskell
 -- http://book.realworldhaskell.org/read/io-case-study-a-library-for-searching-the-filesystem.html
 getRecursiveContents :: FilePath -> IO [FilePath]

src/System/Process/Extra.hs

@@ -5,6 +5,7 @@ module System.Process.Extra where
 import System.Exit
 import System.Process
 
+-- | Read from a process returning both std err and out.
 readAllFromProcess :: FilePath -> [String] -> String -> IO (Either (String,String) (String,String))
 readAllFromProcess program flags input = do
   (code,out,err) <- readProcessWithExitCode program flags input