/ Process.hs - links lit's command line interface and file generation

Process unifies the different ways that lit can produce files. Here are the goals:

  1. Parse a file into a data structure
  2. Pass the data structure through pipelines (Html, Code, Markdown)
  3. Write the output to files

An overview of the file:

<< * >>=
<< define Process module >>
<< import modules >>
<< process a single file >>
<< helper functions >>

Process exports the pipelines so they can be preconfigured. In lit.hs, the pipelines are curried with the output directory corresponding to their type, and with the optional css path. The process function depends on being called with preconfigured pipes.

<< define Process module >>=
{-# LANGUAGE OverloadedStrings #-}
module Process
( process
, htmlPipeline
, mdPipeline
, codePipeline ) where

Besides the reading and writing file utilities, each output format is contained in a module which specifies a generate function. Ex. Html.generate renders the parsed .lit file as Text.

<< import modules >>=
import Prelude hiding (readFile, writeFile)
import Data.Text.IO (writeFile, readFile)
import System.FilePath.Posix (takeFileName, dropExtension)
import System.Directory
import System.FilePath.Posix
import Data.List (intercalate)
import qualified Data.Text as T

import Parse (encode)
import Code
import Html
import Markdown
import Types

Process as a library accompolishes the primary goals through the process function. After reading the file, encode parses the file into [Chunks] (see Types.hs for more about the data structure). Lastly, each pipeline function in the list of pipes is applied to the data structure. Each pipeline takes a [Chunks] and writes a file.

<< process a single file >>=
process pipes file = do 
    stream <- readFile file
    encoded <- return $ encode stream 
    mapM_ (\f -> f fileName encoded) pipes >> return ()
    where
        fileName = dropExtension $ takeFileName file

Beside the main function process. Process as a module defines several useful pipelines (function transforms chained together). Each pipeline can be generalized in the following way.

  1. Append the correct file extention to the filename
  2. Transform [Chunks] -> Text, through a generate function
  3. Write to the path with the transformed text
<< helper functions >>=
<< html pipeline >>
<< markdown pipeline >>
<< code pipeline >>
<< html helpers >>
<< html pipeline >>=
htmlPipeline dir mCss name enc = do
    maybeCss <- cssRelativeToOutput dir mCss
    let path = (addTrailingPathSeparator dir) ++ name ++ ".html"
        output = Html.generate maybeCss name enc
    writeFile path output
<< markdown pipeline >>=
mdPipeline dir css name enc = writeFile path output
    where
        path = (addTrailingPathSeparator dir) ++ name ++ ".md"
        output = Markdown.generate name enc
<< code pipeline >>=
codePipeline dir css name enc = writeFile path output
    where
        path = (addTrailingPathSeparator dir) ++ name
        output = Code.generate enc

The helpers below take a path to a css file and a path to an html file from the current directory and return the path linking the html to the css.

<< html helpers >>=
cssRelativeToOutput :: String -> Maybe String -> IO (Maybe String)
cssRelativeToOutput output mCss =
    case mCss of
    Nothing -> return Nothing
    Just css -> do
    getCurrentDirectory >>= canonicalizePath >>= \path -> return $ Just $ (join' . helper' . trim' . split') path
    where 
        moves = filter (\str -> str /= ".") $ splitDirectories output
        split' = splitDirectories
        trim'   = trimToMatchLength moves
        helper' = reversePath moves []
        join' path = (intercalate "/" path) </> css

trimToMatchLength list listToTrim = 
    let len1 = length list
        len2 = length listToTrim
    in 
        drop (len2 - len1) listToTrim

reversePath [] solution curPathParts = solution
reversePath (fst:rest) solution curPathParts =
    if fst == ".."
    then reversePath rest ((last curPathParts) : solution) (init curPathParts)
    else reversePath rest (".." : solution) (curPathParts ++ [fst])