diff --git a/LICENSE b/LICENSE new file mode 100644 --- /dev/null +++ b/LICENSE @@ -0,0 +1,21 @@ +The MIT License (MIT) + +Copyright (c) 2016 Steven Vandevelde + +Permission is hereby granted, free of charge, to any person obtaining a copy +of this software and associated documentation files (the "Software"), to deal +in the Software without restriction, including without limitation the rights +to use, copy, modify, merge, publish, distribute, sublicense, and/or sell +copies of the Software, and to permit persons to whom the Software is +furnished to do so, subject to the following conditions: + +The above copyright notice and this permission notice shall be included in all +copies or substantial portions of the Software. + +THE SOFTWARE IS PROVIDED "AS IS", WITHOUT WARRANTY OF ANY KIND, EXPRESS OR +IMPLIED, INCLUDING BUT NOT LIMITED TO THE WARRANTIES OF MERCHANTABILITY, +FITNESS FOR A PARTICULAR PURPOSE AND NONINFRINGEMENT. IN NO EVENT SHALL THE +AUTHORS OR COPYRIGHT HOLDERS BE LIABLE FOR ANY CLAIM, DAMAGES OR OTHER +LIABILITY, WHETHER IN AN ACTION OF CONTRACT, TORT OR OTHERWISE, ARISING FROM, +OUT OF OR IN CONNECTION WITH THE SOFTWARE OR THE USE OR OTHER DEALINGS IN THE +SOFTWARE. diff --git a/Setup.hs b/Setup.hs new file mode 100644 --- /dev/null +++ b/Setup.hs @@ -0,0 +1,2 @@ +import Distribution.Simple +main = defaultMain diff --git a/shikensu.cabal b/shikensu.cabal new file mode 100644 --- /dev/null +++ b/shikensu.cabal @@ -0,0 +1,92 @@ +name: shikensu +version: 0.1.0 +category: File IO + +synopsis: + A small toolset for building static websites + +description: + Please see README.md + +homepage: + https://github.com/icidasset/shikensu#README + +license: MIT +license-file: LICENSE + +author: Steven Vandevelde +maintainer: icid.asset@gmail.com + +build-type: Simple +cabal-version: >= 1.10 + + +source-repository head + type: git + location: https://github.com/icidasset/shikensu + + +library + default-language: + Haskell2010 + + default-extensions: + OverloadedStrings + + hs-source-dirs: + src + + exposed-modules: + Shikensu, + Shikensu.Contrib, + Shikensu.Contrib.IO, + Shikensu.Metadata, + Shikensu.Sorting, + Shikensu.Types, + Shikensu.Utilities + + build-depends: + aeson == 0.11.*, + base == 4.*, + bytestring == 0.10.*, + directory >= 1.2.6 && < 2, + filepath == 1.4.*, + flow == 1.0.*, + Glob == 0.7.*, + unordered-containers == 0.2.* + + +test-suite tests + default-language: + Haskell2010 + + ghc-options: + -Wall -threaded -rtsopts -with-rtsopts=-N + + type: + exitcode-stdio-1.0 + + hs-source-dirs: + tests + + main-is: + Test.hs + + other-modules: + Test.Contrib, + Test.Example, + Test.Helpers, + Test.Shikensu + + build-depends: + aeson, + base, + bytestring, + directory, + filepath, + flow, + shikensu, + tasty == 0.11.*, + tasty-hunit == 0.9.*, + text >= 1.2 && < 2, + unordered-containers diff --git a/src/Shikensu.hs b/src/Shikensu.hs new file mode 100644 --- /dev/null +++ b/src/Shikensu.hs @@ -0,0 +1,123 @@ +module Shikensu + ( list + + , forkDefinition + , makeDefinition + , makeDictionary + ) where + + +{-| Shikensu. + +See the README and tests for examples. + +-} + +import Flow +import Shikensu.Types +import Shikensu.Utilities +import System.FilePath + +import qualified Data.HashMap.Strict as HashMap (empty) +import qualified Data.List as List (concat, map, zip) + + + +-- IO + + +{-| Make a single dictionary based on multiple glob patterns and a path to a directory. + +1. Compile patterns so `globDir` can use them. +2. Run `globDir` function on the given (root) path. +3. We get a list back for each pattern (ie. a list of lists), + here we put each child list in a tuple along with its pattern. +4. We make a Dictionary out of each tuple (this also needs the path). +5. Merge the dictionaries into one dictionary. + +-} +list :: [Pattern] -> FilePath -> IO Dictionary +list patterns rootDir = + patterns + |> compilePatterns + |> globDir rootDir + |> fmap (List.zip patterns) + |> fmap (List.map (uncurry . makeDictionary $ rootDir)) + |> fmap (List.concat) + + + + +-- PURE + + +{-| Fork a Definition. +-} +forkDefinition :: FilePath -> Definition -> Definition +forkDefinition newLocalPath def = + Definition + { basename = takeBaseName newLocalPath + , dirname = takeDirName newLocalPath + , extname = takeExtension newLocalPath + , pattern = (pattern def) + , rootDirname = (rootDirname def) + , workingDirname = (workingDirname def) + + -- Additional properties + , content = (content def) + , metadata = (metadata def) + , parentPath = compileParentPath $ takeDirName newLocalPath + , pathToRoot = compilePathToRoot $ takeDirName newLocalPath + } + + + +{-| Make a Definition. + +Example definition, given: +- the root path `/Users/icidasset/Projects/shikensu` +- the pattern `example/**/*.md` +- the workspace path `example/test/hello.md` + + Definition + { basename = "hello" + , dirname = "test" + , extname = ".md" + , pattern = "example/**/*.md" + , rootDirname = "/Users/icidasset/Projects/shikensu" + , workingDirname = "example" + + , content = Nothing + , metadata = HashMap.empty + , parentPath = "../" + , pathToRoot = "../../" + } + +-} +makeDefinition :: FilePath -> Pattern -> FilePath -> Definition +makeDefinition _rootDirname _pattern _workspacePath = + let + workingDir = cleanPath . (commonDirectory) $ _pattern + localPath = cleanPath . (stripPrefix workingDir) . cleanPath $ _workspacePath + in + Definition + { basename = takeBaseName localPath + , dirname = takeDirName localPath + , extname = takeExtension localPath + , pattern = _pattern + , rootDirname = dropTrailingPathSeparator _rootDirname + , workingDirname = workingDir + + -- Additional properties + , content = Nothing + , metadata = HashMap.empty + , parentPath = compileParentPath $ takeDirName localPath + , pathToRoot = compilePathToRoot $ takeDirName localPath + } + + + +{-| Make a Dictionary. +-} +makeDictionary :: FilePath -> Pattern -> [FilePath] -> Dictionary +makeDictionary _rootDirname _pattern = List.map (makeDefinition _rootDirname _pattern) diff --git a/src/Shikensu/Contrib.hs b/src/Shikensu/Contrib.hs new file mode 100644 --- /dev/null +++ b/src/Shikensu/Contrib.hs @@ -0,0 +1,221 @@ +module Shikensu.Contrib + ( clearMetadata + , clearMetadataDef + , clone + , copyPropsToMetadata + , copyPropsToMetadataDef + , exclude + , insertMetadata + , insertMetadataDef + , permalink + , permalinkDef + , prefixDirname + , prefixDirnameDef + , rename + , renameDef + , renameExt + , renameExtDef + , renderContent + , renderContentDef + , replaceMetadata + , replaceMetadataDef + ) where + +import Data.ByteString (ByteString) +import Flow +import Shikensu (forkDefinition) +import Shikensu.Metadata (transposeToMetadata) +import Shikensu.Types +import Shikensu.Utilities (cleanPath, compileParentPath, compilePathToRoot) +import System.FilePath (FilePath, combine) + +import qualified Data.HashMap.Strict as HashMap (empty, union) + + +{-| Clear metadata. + +Replace the current hash map with an empty one. +-} +clearMetadata :: Dictionary -> Dictionary +clearMetadata = fmap (clearMetadataDef) + + +clearMetadataDef :: Definition -> Definition +clearMetadataDef def = def { metadata = HashMap.empty } + + + +{-| Clone. + +For each definition that has the given `localPath` (1st argument), +make a clone with a new `localPath` (2nd argument), +and add that into dictionary just after the matching definition. + +Example: + + clone "index.html" "200.html" dictionary +-} +clone :: FilePath -> FilePath -> Dictionary -> Dictionary +clone existingPath newPath dict = + let + makeNew = \def acc -> + if (localPath def) == existingPath + then acc ++ [forkDefinition newPath def] + else acc + in + dict ++ (foldr makeNew [] dict) + + + +{-| Copy definition properties into the metadata. + +See the `toJSON` implementation for `Definition` in `Shikensu.Types` +to see what properties get put in here. +-} +copyPropsToMetadata :: Dictionary -> Dictionary +copyPropsToMetadata = fmap (copyPropsToMetadataDef) + + +copyPropsToMetadataDef :: Definition -> Definition +copyPropsToMetadataDef def = def { + metadata = HashMap.union (transposeToMetadata def) (metadata def) + } + + + +{-| Exclude. + +Filter out the definitions that have the given `localPath`. +-} +exclude :: FilePath -> Dictionary -> Dictionary +exclude path = filter (\def -> (localPath def) /= path) + + + +{-| Insert metadata. + +Merge the current hash map with another one. +-} +insertMetadata :: Metadata -> Dictionary -> Dictionary +insertMetadata a = fmap (insertMetadataDef a) + + +insertMetadataDef :: Metadata -> Definition -> Definition +insertMetadataDef given def = def { metadata = HashMap.union given (metadata def) } + + + +{-| Permalink. + +Append the basename to the dirname, +and change the basename to the given string. +It will NOT change definitions that already have the new basename. + +Example: + + permalink "index" dictionary +-} +permalink :: String -> Dictionary -> Dictionary +permalink a = fmap (permalinkDef a) + + +permalinkDef :: String -> Definition -> Definition +permalinkDef newBasename def = + if (basename def) /= newBasename + then + let + newDirname = cleanPath $ combine (dirname def) (basename def) + in + def { + basename = newBasename + , dirname = newDirname + + , parentPath = compileParentPath $ newDirname + , pathToRoot = compilePathToRoot $ newDirname + } + + else + def + + + +{-| Prefix dirname. + +Prefix the dirname of each definition with a given string. +-} +prefixDirname :: String -> Dictionary -> Dictionary +prefixDirname prefix = fmap (prefixDirnameDef prefix) + + +prefixDirnameDef :: String -> Definition -> Definition +prefixDirnameDef prefix def = def { dirname = prefix ++ (dirname def) } + + + +{-| Rename. + +Change the `localPath` of the definitions that match a given `localPath`. +For example, if you have a definition with the local path `a/b/example.html`: + + rename "a/b/example.html" "example/index.html" dictionary + +See `Shikensu.localPath` for more info. +-} +rename :: FilePath -> FilePath -> Dictionary -> Dictionary +rename a b = fmap (renameDef a b) + + +renameDef :: FilePath -> FilePath -> Definition -> Definition +renameDef oldPath newPath def = + if (localPath def) == oldPath + then forkDefinition newPath def + else def + + + +{-| Rename extension. + +Example: + + renameExt ".markdown" ".html" dictionary + -- The definitions that had the extname ".markdown" + -- now have the extname ".html" +-} +renameExt :: String -> String -> Dictionary -> Dictionary +renameExt a b = fmap (renameExtDef a b) + + +renameExtDef :: String -> String -> Definition -> Definition +renameExtDef oldExtname newExtname def = + if (extname def) == oldExtname + then def { extname = newExtname } + else def + + + +{-| Render content. + +Replace the content property by providing a renderer. +A renderer is a function with the signature `Definition -> Maybe ByteString`. + +You can use this to render templates, markdown, etc. +-} +renderContent :: (Definition -> Maybe ByteString) -> Dictionary -> Dictionary +renderContent a = fmap (renderContentDef a) + + +renderContentDef :: (Definition -> Maybe ByteString) -> Definition -> Definition +renderContentDef renderer def = def { content = renderer def } + + + +{-| Replace metadata. + +Replace the current hash map with another one. +-} +replaceMetadata :: Metadata -> Dictionary -> Dictionary +replaceMetadata a = fmap (replaceMetadataDef a) + + +replaceMetadataDef :: Metadata -> Definition -> Definition +replaceMetadataDef given def = def { metadata = given } diff --git a/src/Shikensu/Contrib/IO.hs b/src/Shikensu/Contrib/IO.hs new file mode 100644 --- /dev/null +++ b/src/Shikensu/Contrib/IO.hs @@ -0,0 +1,60 @@ +module Shikensu.Contrib.IO + ( Shikensu.Contrib.IO.read + , Shikensu.Contrib.IO.readDef + , Shikensu.Contrib.IO.write + , Shikensu.Contrib.IO.writeDef + ) where + +import Data.Maybe (fromMaybe) +import Flow +import Shikensu.Types +import System.Directory (createDirectoryIfMissing, doesFileExist) +import System.FilePath (FilePath, joinPath, takeDirectory) + +import qualified Data.ByteString as B (empty, readFile, writeFile) +import qualified Shikensu.Utilities as Utilities (mapIO) + + +{-| Read. + +Read the contents of each file, and for each file (ie. definition) +put that content in the `content` property. +-} +read :: Dictionary -> IO Dictionary +read = Utilities.mapIO (readDef) + + +readDef :: Definition -> IO Definition +readDef def = + let + absPath = absolutePath def + in + doesFileExist absPath >>= \exists -> + if exists then + fmap + (\c -> def { content = Just c }) + (B.readFile absPath) + else + return + def { content = Nothing } + + + +{-| Write. + +Write the contents of each definition to a file. +The path of the new file is `joinPath [rootDirname, givenDirectoryName, localPath]`. +-} +write :: FilePath -> Dictionary -> IO Dictionary +write dest = Utilities.mapIO (writeDef dest) + + +writeDef :: FilePath -> Definition -> IO Definition +writeDef dest def = + let + path = joinPath [rootDirname def, dest, localPath def] + cont = fromMaybe B.empty (content def) + in + createDirectoryIfMissing True (takeDirectory path) + >> B.writeFile path cont + >> return def diff --git a/src/Shikensu/Metadata.hs b/src/Shikensu/Metadata.hs new file mode 100644 --- /dev/null +++ b/src/Shikensu/Metadata.hs @@ -0,0 +1,55 @@ +module Shikensu.Metadata + ( transposeMetadata + , transposeToMetadata + ) where + + +{-| Metadata functions. +-} + +import Flow +import Shikensu.Types + +import qualified Data.Aeson as Aeson (FromJSON, Result(..), ToJSON, fromJSON, toJSON) +import qualified Data.HashMap.Strict as HashMap (empty) + + + +{-| Transpose metadata. + +Transpose our metadata object to a given type +which implements the Aeson.FromJSON instance. + + data Example = + Example { some :: Text } + deriving (Generic, FromJSON) + + hashMap = HashMap.fromList [ ("some", "metadata") ] + defaultEx = Example { some = "default" } + example = transposeMetadata hashMap defaultExample :: Example + +-} +transposeMetadata :: Aeson.FromJSON a => Metadata -> a -> a +transposeMetadata hashMap fallback = + let + result = hashMap + |> Aeson.toJSON + |> Aeson.fromJSON :: Aeson.FromJSON b => Aeson.Result b + in + case result of + Aeson.Success x -> x + Aeson.Error _ -> fallback + + +{-| Inverse of `transposeMetadata`. +-} +transposeToMetadata :: (Aeson.ToJSON a) => a -> Metadata +transposeToMetadata generic = + let + result = generic + |> Aeson.toJSON + |> Aeson.fromJSON :: Aeson.FromJSON b => Aeson.Result b + in + case result of + Aeson.Success x -> x + Aeson.Error _ -> HashMap.empty diff --git a/src/Shikensu/Sorting.hs b/src/Shikensu/Sorting.hs new file mode 100644 --- /dev/null +++ b/src/Shikensu/Sorting.hs @@ -0,0 +1,20 @@ +module Shikensu.Sorting + ( sortByAbsolutePath + ) where + + +{-| Sorting functions. + +Example: + + Data.List.sortBy Shikensu.sortByAbsolutePath dictionary + +-} + +import Shikensu.Types (Definition, absolutePath) + + + +sortByAbsolutePath :: Definition -> Definition -> Ordering +sortByAbsolutePath defA defB = + compare (absolutePath defA) (absolutePath defB) diff --git a/src/Shikensu/Types.hs b/src/Shikensu/Types.hs new file mode 100644 --- /dev/null +++ b/src/Shikensu/Types.hs @@ -0,0 +1,67 @@ +module Shikensu.Types where + +import Data.Aeson (ToJSON, Object, (.=), object, toJSON) +import Data.ByteString (ByteString) +import System.FilePath (joinPath) + + +{-| A file definition, along with some additional properties. +-} +data Definition = + Definition + { basename :: String + , dirname :: FilePath + , extname :: String + , pattern :: Pattern + , rootDirname :: FilePath + , workingDirname :: FilePath + + -- Additional properties + , content :: Maybe ByteString + , metadata :: Metadata + , parentPath :: Maybe FilePath + , pathToRoot :: FilePath + } deriving (Eq, Show) + + +instance ToJSON Definition where + toJSON def = + object + [ "basename" .= basename def + , "dirname" .= dirname def + , "extname" .= extname def + , "pattern" .= pattern def + , "workingDirname" .= workingDirname def + , "parentPath" .= parentPath def + , "pathToRoot" .= pathToRoot def + ] + + + + +-- Type aliases + + +type Dictionary = [Definition] +type Metadata = Object +type Pattern = String + + + + +-- Path functions + + +absolutePath :: Definition -> String +absolutePath def = + joinPath [rootDirname def, workspacePath def] + + +localPath :: Definition -> String +localPath def = + joinPath [dirname def, (basename def) ++ (extname def)] + + +workspacePath :: Definition -> String +workspacePath def = + joinPath [workingDirname def, localPath def] diff --git a/src/Shikensu/Utilities.hs b/src/Shikensu/Utilities.hs new file mode 100644 --- /dev/null +++ b/src/Shikensu/Utilities.hs @@ -0,0 +1,117 @@ +module Shikensu.Utilities + ( cleanPath + , commonDirectory + , compilePatterns + , compileParentPath + , compilePathToRoot + , globDir + , io + , mapIO + , replaceSingleDot + , stripPrefix + , takeDirName + ) where + +import Data.Maybe (fromMaybe) +import Data.Tuple (fst) +import Flow +import Shikensu.Types +import System.FilePath + +import qualified Data.List as List (map, stripPrefix) +import qualified System.FilePath.Glob as Glob + + +{-| "Clean up" a path. + +`/directory/./nested/` -> `directory/nested` +`./` -> `` +`.` -> `` + +-} +cleanPath :: FilePath -> FilePath +cleanPath = normalise .> dropTrailingPathSeparator .> dropDrive .> replaceSingleDot + + +{-| Get the common directory from a Pattern. +-} +commonDirectory :: Pattern -> FilePath +commonDirectory pattern = (Glob.compile .> Glob.commonDirectory .> fst) pattern + + +{-| Compile a list of `Pattern`s to `Glob.Pattern`s. +-} +compilePatterns :: [Pattern] -> [Glob.Pattern] +compilePatterns = List.map Glob.compile + + +{-| Path to parent, when there is one. + + Just "../" or Nothing + +-} +compileParentPath :: FilePath -> Maybe FilePath +compileParentPath dirname = + case dirname of + "" -> Nothing + _ -> Just "../" + + +{-| Path to root. + +Example, if `dirname` is 'example/subdir', +then this will be `../../`. + +If the `dirname` is empty, +then this will be empty as well. + +-} +compilePathToRoot :: FilePath -> FilePath +compilePathToRoot dirname = + if dirname == "" then + "" + else + dirname + |> splitDirectories + |> fmap (\_ -> "..") + |> joinPath + |> addTrailingPathSeparator + + +{-| List contents of a directory using a glob pattern. +Returns a relative path, based on the given rootDirname. +-} +globDir :: FilePath -> [Glob.Pattern] -> IO [[FilePath]] +globDir rootDir patterns = + Glob.globDir patterns rootDir + |> fmap (fst) + |> fmap (List.map . List.map . makeRelative $ rootDir) + + +{-| IO Sequence helpers +-} +io :: ([Definition] -> [IO Definition]) -> Dictionary -> IO Dictionary +io fn = sequence . fn + + +mapIO :: (Definition -> IO Definition) -> Dictionary -> IO Dictionary +mapIO = io . fmap + + +{-| If the path is a single dot, return an empty string. +Otherwise return the path. +-} +replaceSingleDot :: String -> String +replaceSingleDot path = if path == "." then "" else path + + +{-| Strip prefix. +-} +stripPrefix :: String -> String -> String +stripPrefix prefix target = fromMaybe target (List.stripPrefix prefix target) + + +{-| Take dirname. +-} +takeDirName :: FilePath -> FilePath +takeDirName = replaceSingleDot . takeDirectory diff --git a/tests/Test.hs b/tests/Test.hs new file mode 100644 --- /dev/null +++ b/tests/Test.hs @@ -0,0 +1,21 @@ +import Control.Exception (catch) +import System.Directory (removeDirectoryRecursive) +import System.FilePath (combine) +import Test.Contrib +import Test.Example +import Test.Helpers (ioErrorHandler, rootPath) +import Test.Shikensu +import Test.Tasty + + +main :: IO () +main = + rootPath + >>= \r -> catch + (removeDirectoryRecursive (combine r "tests/build")) + (ioErrorHandler) + >> defaultMain tests + + +tests :: TestTree +tests = testGroup "Tests" [shikensuTests, contribTests, exampleTests] diff --git a/tests/Test/Contrib.hs b/tests/Test/Contrib.hs new file mode 100644 --- /dev/null +++ b/tests/Test/Contrib.hs @@ -0,0 +1,233 @@ +module Test.Contrib (contribTests) where + +import Data.ByteString (ByteString) +import Flow +import System.FilePath (joinPath) +import Test.Helpers +import Test.Tasty +import Test.Tasty.HUnit + +import qualified Data.Aeson.Types as Aeson (Value(..)) +import qualified Data.ByteString as B (empty) +import qualified Data.ByteString.Char8 as BS (intercalate, pack) +import qualified Data.HashMap.Strict as HashMap (fromList, lookup) +import qualified Data.List as List (head, reverse) +import qualified Data.Text as Text (pack, unpack) +import qualified Data.Text.IO as Text (readFile) +import qualified Data.Text.Encoding as Text (decodeUtf8) +import qualified Shikensu +import qualified Shikensu.Contrib as Contrib +import qualified Shikensu.Contrib.IO as Contrib.IO +import qualified Shikensu.Types as Shikensu + + +contribTests :: TestTree +contribTests = testGroup + "Contrib tests" + [ testClone + , testExclude + , testMetadata + , testPermalink + , testPrefixDirname + , testRead + , testRename + , testRenameExt + , testRenderContent + , testWrite + ] + + + + +-- Test data + + +list :: Shikensu.Pattern -> IO Shikensu.Dictionary +list pattern = rootPath >>= Shikensu.list [pattern] + + +example_md :: IO Shikensu.Dictionary +example_md = list "tests/fixtures/example.md" + + +renderer :: Shikensu.Definition -> Maybe ByteString +renderer def = + let + openingTag = BS.pack "" + closingTag = BS.pack "" + in + def + |> Shikensu.content + |> fmap (\c -> BS.intercalate B.empty [openingTag, c, closingTag]) + + + + +-- Tests + + +testClone :: TestTree +testClone = + let + dictionary = fmap (Contrib.clone "example.md" "cloned.md") example_md + definition = fmap (List.head . List.reverse) dictionary + in + testCase "Should `clone`" + $ definition `rmap` Shikensu.localPath >>= assertEq "cloned.md" + + + +testExclude :: TestTree +testExclude = + let + dictionary = fmap (Contrib.exclude "example.md") example_md + length_ = fmap length dictionary + in + testCase "Should `exclude`" + $ length_ >>= assertEq 0 + + + +testMetadata :: TestTree +testMetadata = + let + keyA = Text.pack "title" + valueA = Aeson.String (Text.pack "Hello world!") + + keyB = Text.pack "hello" + valueB = Aeson.String (Text.pack "Guardian.") + + keyC = Text.pack "removed" + valueC = Aeson.String (Text.pack "Me.") + + keyBase = Text.pack "basename" + valueBase = Aeson.String (Text.pack "example") + + -- 1. Insert C + -- 2. Replace with A + -- 3. Insert B + dictionary = example_md + <&> ( Contrib.insertMetadata (HashMap.fromList [ (keyC, valueC) ]) + .> Contrib.replaceMetadata (HashMap.fromList [ (keyA, valueA) ]) + .> Contrib.copyPropsToMetadata + .> Contrib.insertMetadata (HashMap.fromList [ (keyB, valueB) ]) + ) + + definition = fmap (List.head . List.reverse) dictionary + + lookupTitle = \def -> HashMap.lookup keyA (Shikensu.metadata def) + lookupHello = \def -> HashMap.lookup keyB (Shikensu.metadata def) + lookupRemoved = \def -> HashMap.lookup keyC (Shikensu.metadata def) + lookupBasename = \def -> HashMap.lookup keyBase (Shikensu.metadata def) + in + testGroup + "Metadata" + [ testCase "Should no longer have `removed` key" + $ definition `rmap` lookupRemoved >>= assertEq Nothing + + , testCase "Should have `hello` key" + $ definition `rmap` lookupHello >>= assertEq (Just valueB) + + , testCase "Should have `title` key" + $ definition `rmap` lookupTitle >>= assertEq (Just valueA) + + , testCase "Should have `basename` key" + $ definition `rmap` lookupBasename >>= assertEq (Just valueBase) + ] + + + +testPermalink :: TestTree +testPermalink = + let + dictionary = fmap (Contrib.permalink "index") example_md + definition = fmap (List.head) dictionary + in + testGroup + "Permalink" + [ testCase "Should have the correct `localPath`" + $ definition `rmap` Shikensu.localPath >>= assertEq "example/index.md" + + , testCase "Should have the correct `parentPath`" + $ definition `rmap` Shikensu.parentPath >>= assertEq (Just "../") + + , testCase "Should have the correct `pathToRoot`" + $ definition `rmap` Shikensu.pathToRoot >>= assertEq "../" + ] + + + +testPrefixDirname :: TestTree +testPrefixDirname = + let + dictionary = fmap (Contrib.prefixDirname "prefix/") (list "tests/**/example.md") + definition = fmap List.head dictionary + in + testCase "Should `prefixDirname`" + $ definition `rmap` Shikensu.dirname >>= assertEq "prefix/fixtures" + + + +testRead :: TestTree +testRead = + let + dictionary = example_md >>= Contrib.IO.read + definition = fmap List.head dictionary + in + testCase "Should `read`" + $ definition + <&> Shikensu.content + <&> fmap Text.decodeUtf8 + >>= assertEq (Just (Text.pack "# Example\n")) + + + +testRename :: TestTree +testRename = + let + dictionary = fmap (Contrib.rename "example.md" "renamed.md") example_md + definition = fmap (List.head) dictionary + in + testCase "Should `rename`" + $ definition `rmap` Shikensu.localPath >>= assertEq "renamed.md" + + + +testRenameExt :: TestTree +testRenameExt = + let + dictionary = fmap (Contrib.renameExt ".md" ".html") example_md + definition = fmap (List.head) dictionary + in + testCase "Should `renameExt`" + $ definition `rmap` Shikensu.extname >>= assertEq ".html" + + + +testRenderContent :: TestTree +testRenderContent = + let + dictionary = fmap (Contrib.renderContent renderer) (example_md >>= Contrib.IO.read) + definition = fmap (List.head) dictionary + expectedResult = Just (Text.pack "# Example\n") + in + testCase "Should `renderContent`" + $ definition + <&> Shikensu.content + <&> fmap Text.decodeUtf8 + >>= assertEq expectedResult + + + +testWrite :: TestTree +testWrite = + let + destination = "tests/build/" + dictionary = list "tests/**/example.md" >>= Contrib.IO.read >>= Contrib.IO.write destination + definition = fmap List.head dictionary + in + testCase "Should `write`" + $ definition + <&> Shikensu.rootDirname + >>= \r -> Text.readFile (joinPath [r, destination, "fixtures/example.md"]) + >>= \c -> assertEq "# Example\n" (Text.unpack c) diff --git a/tests/Test/Example.hs b/tests/Test/Example.hs new file mode 100644 --- /dev/null +++ b/tests/Test/Example.hs @@ -0,0 +1,64 @@ +module Test.Example (exampleTests) where + +import Data.Text (Text) +import System.Directory (canonicalizePath) +import Test.Helpers +import Test.Tasty +import Test.Tasty.HUnit + +import qualified Data.Text.Encoding as Text (decodeUtf8, encodeUtf8) +import qualified Shikensu + +import Data.ByteString (ByteString) +import Flow +import Prelude hiding (read) +import Shikensu.Types +import Shikensu.Contrib +import Shikensu.Contrib.IO (read, write) + + +exampleTests :: TestTree +exampleTests = + let + path = canonicalizePath "./tests" + dict = path >>= dictionary_io + test = path >>= \p -> + read [Shikensu.makeDefinition p "fixtures/*.md" "fixtures/example.md"] + >>= flow + in + testCase "Example test" + $ dict >>= \d -> test >>= assertEq d + + + +-- Setup + + +dictionary_io :: String -> IO Dictionary +dictionary_io absolutePathToCwd = + Shikensu.list ["fixtures/*.md"] absolutePathToCwd + >>= read + >>= flow + >>= write "./build" + + +flow :: Dictionary -> IO Dictionary +flow = + renameExt ".md" ".html" + .> permalink "index" + .> clone "index.html" "200.html" + .> copyPropsToMetadata + .> renderContent markdownRenderer + .> return + + +markdownRenderer :: Definition -> Maybe ByteString +markdownRenderer def = + content def + |> fmap Text.decodeUtf8 + |> fmap renderMarkdown + |> fmap Text.encodeUtf8 + + +renderMarkdown :: Text -> Text +renderMarkdown text = text diff --git a/tests/Test/Helpers.hs b/tests/Test/Helpers.hs new file mode 100644 --- /dev/null +++ b/tests/Test/Helpers.hs @@ -0,0 +1,45 @@ +module Test.Helpers + ( (<&>) + , rmap + , assertEq + , ioErrorHandler + , rootPath + , sort + , testsPath + ) where + +import Shikensu.Sorting (sortByAbsolutePath) +import Shikensu.Types (Dictionary) +import System.Directory (canonicalizePath) +import System.FilePath (combine) +import Test.Tasty.HUnit (Assertion, assertEqual) + +import qualified Data.List as List + + +(<&>) :: Functor f => f a -> (a -> b) -> f b +(<&>) = flip fmap + + +rmap :: Functor f => f a -> (a -> b) -> f b +rmap = (<&>) + + +assertEq :: (Eq a, Show a) => a -> a -> Assertion +assertEq = assertEqual "" + + +ioErrorHandler :: IOError -> IO () +ioErrorHandler _ = putStrLn "" + + +rootPath :: IO FilePath +rootPath = canonicalizePath "./" + + +sort :: Dictionary -> Dictionary +sort = List.sortBy sortByAbsolutePath + + +testsPath :: IO FilePath +testsPath = fmap ((flip combine) "tests") rootPath diff --git a/tests/Test/Shikensu.hs b/tests/Test/Shikensu.hs new file mode 100644 --- /dev/null +++ b/tests/Test/Shikensu.hs @@ -0,0 +1,140 @@ +module Test.Shikensu (shikensuTests) where + +import Test.Helpers +import Test.Tasty +import Test.Tasty.HUnit + +import qualified Data.List as List (head) +import qualified Shikensu +import qualified Shikensu.Types as Shikensu + + +shikensuTests :: TestTree +shikensuTests = testGroup + "Shikensu tests" + [testRegular, testDot, testWithoutWd, testRootFile] + + + + +-- Tests + + +testRegular :: TestTree +testRegular = + let + pattern = "tests/**/*.md" + dictionary = fmap sort $ rootPath >>= Shikensu.list [pattern] + definition = fmap List.head dictionary + localPath = "fixtures/example.md" + in + testGroup "Test regular" + [ testCase "Should have the correct basename" + $ definition `rmap` Shikensu.basename >>= assertEq "example" + + , testCase "Should have the correct dirname" + $ definition `rmap` Shikensu.dirname >>= assertEq "fixtures" + + , testCase "Should have the correct extname" + $ definition `rmap` Shikensu.extname >>= assertEq ".md" + + , testCase "Should have the correct localPath" + $ definition `rmap` Shikensu.localPath >>= assertEq localPath + + , testCase "Should have the correct pattern" + $ definition `rmap` Shikensu.pattern >>= assertEq pattern + + , testCase "Should have the correct workingDirname" + $ definition `rmap` Shikensu.workingDirname >>= assertEq "tests" + + ] + + +testDot :: TestTree +testDot = + let + pattern = "./tests/**/*.md" + dictionary = fmap sort $ rootPath >>= Shikensu.list [pattern] + definition = fmap List.head dictionary + localPath = "fixtures/example.md" + in + testGroup "Test dot" + [ testCase "Should have the correct basename" + $ definition `rmap` Shikensu.basename >>= assertEq "example" + + , testCase "Should have the correct dirname" + $ definition `rmap` Shikensu.dirname >>= assertEq "fixtures" + + , testCase "Should have the correct extname" + $ definition `rmap` Shikensu.extname >>= assertEq ".md" + + , testCase "Should have the correct localPath" + $ definition `rmap` Shikensu.localPath >>= assertEq localPath + + , testCase "Should have the correct pattern" + $ definition `rmap` Shikensu.pattern >>= assertEq pattern + + , testCase "Should have the correct workingDirname" + $ definition `rmap` Shikensu.workingDirname >>= assertEq "tests" + + ] + + +testWithoutWd :: TestTree +testWithoutWd = + let + pattern = "**/*.md" + dictionary = fmap sort $ testsPath >>= Shikensu.list [pattern] + definition = fmap List.head dictionary + localPath = "fixtures/example.md" + in + testGroup "Test without workingDirname" + [ testCase "Should have the correct basename" + $ definition `rmap` Shikensu.basename >>= assertEq "example" + + , testCase "Should have the correct dirname" + $ definition `rmap` Shikensu.dirname >>= assertEq "fixtures" + + , testCase "Should have the correct extname" + $ definition `rmap` Shikensu.extname >>= assertEq ".md" + + , testCase "Should have the correct localPath" + $ definition `rmap` Shikensu.localPath >>= assertEq localPath + + , testCase "Should have the correct pattern" + $ definition `rmap` Shikensu.pattern >>= assertEq pattern + + , testCase "Should have the correct workingDirname" + $ definition `rmap` Shikensu.workingDirname >>= assertEq "" + + ] + + +testRootFile :: TestTree +testRootFile = + let + pattern = "*.md" + dictionary = fmap sort $ rootPath >>= Shikensu.list [pattern] + definition = fmap List.head dictionary + localPath = "README.md" + in + testGroup "Test file in root path" + [ testCase "Should have the correct basename" + $ definition `rmap` Shikensu.basename >>= assertEq "README" + + , testCase "Should have the correct dirname" + $ definition `rmap` Shikensu.dirname >>= assertEq "" + + , testCase "Should have the correct extname" + $ definition `rmap` Shikensu.extname >>= assertEq ".md" + + , testCase "Should have the correct localPath" + $ definition `rmap` Shikensu.localPath >>= assertEq localPath + + , testCase "Should have the correct pattern" + $ definition `rmap` Shikensu.pattern >>= assertEq pattern + + , testCase "Should have the correct workingDirname" + $ definition `rmap` Shikensu.workingDirname >>= assertEq "" + + ]