{-| Shikensu.

See the README and tests for examples.

-}
module Shikensu
    ( forkDefinition
    , list
    , listF
    , listRelative
    , listRelativeF
    , makeDefinition
    , makeDictionary
    , module Shikensu.Internal.Types
    ) where

import Data.Monoid ((<>))
import Flow
import Shikensu.Internal.Types
import Shikensu.Internal.Utilities
import System.FilePath

import qualified Data.Aeson.KeyMap as KeyMap (empty)
import qualified Data.List as List (concatMap, map, zip)
import qualified System.Directory as Dir (canonicalizePath)
import qualified System.FilePath.Glob as Glob (compile, globDir1)


-- IO


{-| Make a single dictionary based on a path to a directory and multiple glob patterns.

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 ["*.md"] "/root/articles"

-}
list :: [String] -> FilePath -> IO Dictionary
list :: [String] -> String -> IO Dictionary
list [String]
patterns String
rootDir =
    [String]
patterns
        [String] -> ([String] -> [Pattern]) -> [Pattern]
forall a b. a -> (a -> b) -> b
|> (String -> Pattern) -> [String] -> [Pattern]
forall a b. (a -> b) -> [a] -> [b]
List.map (String -> Pattern
Glob.compile)
        [Pattern] -> ([Pattern] -> [IO [String]]) -> [IO [String]]
forall a b. a -> (a -> b) -> b
|> (Pattern -> IO [String]) -> [Pattern] -> [IO [String]]
forall a b. (a -> b) -> [a] -> [b]
List.map ((Pattern -> String -> IO [String])
-> String -> Pattern -> IO [String]
forall a b c. (a -> b -> c) -> b -> a -> c
flip Pattern -> String -> IO [String]
Glob.globDir1 (String -> Pattern -> IO [String])
-> String -> Pattern -> IO [String]
forall a b. (a -> b) -> a -> b
$ String
rootDir)
        [IO [String]] -> ([IO [String]] -> IO [[String]]) -> IO [[String]]
forall a b. a -> (a -> b) -> b
|> [IO [String]] -> IO [[String]]
forall (t :: * -> *) (m :: * -> *) a.
(Traversable t, Monad m) =>
t (m a) -> m (t a)
sequence
        IO [[String]]
-> (IO [[String]] -> IO [(String, [String])])
-> IO [(String, [String])]
forall a b. a -> (a -> b) -> b
|> ([[String]] -> [(String, [String])])
-> IO [[String]] -> IO [(String, [String])]
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap ([String] -> [[String]] -> [(String, [String])]
forall a b. [a] -> [b] -> [(a, b)]
List.zip [String]
patterns)
        IO [(String, [String])]
-> (IO [(String, [String])] -> IO Dictionary) -> IO Dictionary
forall a b. a -> (a -> b) -> b
|> ([(String, [String])] -> Dictionary)
-> IO [(String, [String])] -> IO Dictionary
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap (((String, [String]) -> Dictionary)
-> [(String, [String])] -> Dictionary
forall (t :: * -> *) a b. Foldable t => (a -> [b]) -> t a -> [b]
List.concatMap (((String, [String]) -> Dictionary)
 -> [(String, [String])] -> Dictionary)
-> ((String, [String]) -> Dictionary)
-> [(String, [String])]
-> Dictionary
forall a b. (a -> b) -> a -> b
$ String -> (String, [String]) -> Dictionary
makeDictionary String
rootDir)


{-| Flipped version of `list`.
-}
listF :: FilePath -> [String] -> IO Dictionary
listF :: String -> [String] -> IO Dictionary
listF = ([String] -> String -> IO Dictionary)
-> String -> [String] -> IO Dictionary
forall a b c. (a -> b -> c) -> b -> a -> c
flip [String] -> String -> IO Dictionary
list


{-| Same as `list`, but given a relative directory.

> listRelative ["*.md"] "./articles"

-}
listRelative :: [String] -> FilePath -> IO Dictionary
listRelative :: [String] -> String -> IO Dictionary
listRelative [String]
patterns String
relativePath =
    String -> IO String
Dir.canonicalizePath String
relativePath IO String -> (String -> IO Dictionary) -> IO Dictionary
forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>= [String] -> String -> IO Dictionary
list [String]
patterns


{-| Flipped version `listRelative`.
-}
listRelativeF :: FilePath -> [String] -> IO Dictionary
listRelativeF :: String -> [String] -> IO Dictionary
listRelativeF = ([String] -> String -> IO Dictionary)
-> String -> [String] -> IO Dictionary
forall a b c. (a -> b -> c) -> b -> a -> c
flip [String] -> String -> IO Dictionary
listRelative



-- PURE


{-| Fork a Definition.
-}
forkDefinition :: FilePath -> Definition -> Definition
forkDefinition :: String -> Definition -> Definition
forkDefinition String
newLocalPath Definition
def =
    Definition :: String
-> String
-> String
-> String
-> String
-> String
-> Maybe ByteString
-> Metadata
-> Maybe String
-> String
-> Definition
Definition
        { $sel:basename:Definition :: String
basename        = String -> String
takeBaseName String
newLocalPath
        , $sel:dirname:Definition :: String
dirname         = String -> String
takeDirName String
newLocalPath
        , $sel:extname:Definition :: String
extname         = String -> String
takeExtension String
newLocalPath
        , $sel:pattern:Definition :: String
pattern         = (Definition -> String
pattern Definition
def)
        , $sel:rootDirname:Definition :: String
rootDirname     = (Definition -> String
rootDirname Definition
def)
        , $sel:workingDirname:Definition :: String
workingDirname  = (Definition -> String
workingDirname Definition
def)

        -- Additional properties
        , $sel:content:Definition :: Maybe ByteString
content         = (Definition -> Maybe ByteString
content Definition
def)
        , $sel:metadata:Definition :: Metadata
metadata        = (Definition -> Metadata
metadata Definition
def)
        , $sel:parentPath:Definition :: Maybe String
parentPath      = String -> Maybe String
compileParentPath (String -> Maybe String) -> String -> Maybe String
forall a b. (a -> b) -> a -> b
$ String -> String
takeDirName String
newLocalPath
        , $sel:pathToRoot:Definition :: String
pathToRoot      = String -> String
compilePathToRoot (String -> String) -> String -> String
forall a b. (a -> b) -> a -> b
$ String -> String
takeDirName String
newLocalPath
        }



{-| Make a Definition.

Example definition, given:

- the root path `/Users/icidasset/Projects/shikensu`
- the pattern `example/**/*.md`
- the absolute path `/Users/icidasset/Projects/shikensu/example/test/hello.md`

> Definition
>     { basename = "hello"
>     , dirname = "test"
>     , extname = ".md"
>     , pattern = "example/**/*.md"
>     , rootDirname = "/Users/icidasset/Projects/shikensu"
>     , workingDirname = "example"
>
>     , content = Nothing
>     , metadata = KeyMap.empty
>     , parentPath = "../"
>     , pathToRoot = "../../"
>     }

-}
makeDefinition :: FilePath -> String -> FilePath -> Definition
makeDefinition :: String -> String -> String -> Definition
makeDefinition String
rootDirname String
pattern String
absolutePath =
    let
        workingDirname :: String
workingDirname      = String -> String
commonDirectory String
pattern
        rootWorkingDirname :: String
rootWorkingDirname  = (String -> String -> String
combine String
rootDirname String
workingDirname) String -> String -> String
forall a. Semigroup a => a -> a -> a
<> [ Char
pathSeparator ]

        theAbsolutePath :: String
theAbsolutePath     = String -> String
normalise String
absolutePath
        theLocalPath :: String
theLocalPath        = String -> String -> String
stripPrefix String
rootWorkingDirname String
theAbsolutePath
    in
        Definition :: String
-> String
-> String
-> String
-> String
-> String
-> Maybe ByteString
-> Metadata
-> Maybe String
-> String
-> Definition
Definition
            { $sel:basename:Definition :: String
basename        = String -> String
takeBaseName String
theLocalPath
            , $sel:dirname:Definition :: String
dirname         = String -> String
takeDirName String
theLocalPath
            , $sel:extname:Definition :: String
extname         = String -> String
takeExtension String
theLocalPath
            , $sel:pattern:Definition :: String
pattern         = String
pattern
            , $sel:rootDirname:Definition :: String
rootDirname     = String
rootDirname
            , $sel:workingDirname:Definition :: String
workingDirname  = String
workingDirname

            -- Additional properties
            , $sel:content:Definition :: Maybe ByteString
content         = Maybe ByteString
forall a. Maybe a
Nothing
            , $sel:metadata:Definition :: Metadata
metadata        = Metadata
forall v. KeyMap v
KeyMap.empty
            , $sel:parentPath:Definition :: Maybe String
parentPath      = String -> Maybe String
compileParentPath (String -> Maybe String) -> String -> Maybe String
forall a b. (a -> b) -> a -> b
$ String -> String
takeDirName String
theLocalPath
            , $sel:pathToRoot:Definition :: String
pathToRoot      = String -> String
compilePathToRoot (String -> String) -> String -> String
forall a b. (a -> b) -> a -> b
$ String -> String
takeDirName String
theLocalPath
            }



{-| Make a Dictionary.
-}
makeDictionary :: FilePath -> (String, [FilePath]) -> Dictionary
makeDictionary :: String -> (String, [String]) -> Dictionary
makeDictionary String
rootDirname (String
pattern, [String]
filepaths) =
    (String -> Definition) -> [String] -> Dictionary
forall a b. (a -> b) -> [a] -> [b]
List.map (String -> String -> String -> Definition
makeDefinition String
rootDirname String
pattern) [String]
filepaths