{-|
Module      : Slick.Utils
Description : Slick helper utilities
Copyright   : (c) Chris Penner, 2019
License     : BSD3
-}
module Slick.Utils
  ( getDirectoryPaths
  , convert
  ) where

import Data.Aeson as A
import Development.Shake
import Development.Shake.FilePath

------------------------------------------------------------------------------
-- Helper functions

-- | Given a list of extensions and directories,
--   find all files that match, and return full paths.
getDirectoryPaths :: [FilePath]         -- ^ file pattern like *.md
                  -> [FilePath]         -- ^ directories to look at
                  -> Action [FilePath]
getDirectoryPaths :: [FilePath] -> [FilePath] -> Action [FilePath]
getDirectoryPaths [FilePath]
extensions [FilePath]
dirs =
  [[FilePath]] -> [FilePath]
forall (t :: * -> *) a. Foldable t => t [a] -> [a]
concat ([[FilePath]] -> [FilePath])
-> Action [[FilePath]] -> Action [FilePath]
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> (FilePath -> Action [FilePath])
-> [FilePath] -> Action [[FilePath]]
forall (t :: * -> *) (m :: * -> *) a b.
(Traversable t, Monad m) =>
(a -> m b) -> t a -> m (t b)
mapM FilePath -> Action [FilePath]
getPaths [FilePath]
dirs
    where
      getPaths :: FilePath -> Action [FilePath]
      getPaths :: FilePath -> Action [FilePath]
getPaths FilePath
dir =
        (FilePath -> FilePath) -> [FilePath] -> [FilePath]
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap (FilePath
dir FilePath -> FilePath -> FilePath
</>) ([FilePath] -> [FilePath])
-> Action [FilePath] -> Action [FilePath]
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$>
          FilePath -> [FilePath] -> Action [FilePath]
getDirectoryFiles FilePath
dir [FilePath]
extensions

-- | Attempt to convert between two JSON serializable objects (or 'Value's).
--   Failure to deserialize fails the Shake build.
convert :: (FromJSON a, ToJSON a, FromJSON b) => a -> Action b
convert :: a -> Action b
convert a
a = case Value -> Result b
forall a. FromJSON a => Value -> Result a
fromJSON (a -> Value
forall a. ToJSON a => a -> Value
toJSON a
a) of
  A.Success b
r   -> b -> Action b
forall (f :: * -> *) a. Applicative f => a -> f a
pure b
r
  A.Error   FilePath
err -> FilePath -> Action b
forall (m :: * -> *) a. MonadFail m => FilePath -> m a
fail (FilePath -> Action b) -> FilePath -> Action b
forall a b. (a -> b) -> a -> b
$ FilePath
"json conversion error:" FilePath -> FilePath -> FilePath
forall a. [a] -> [a] -> [a]
++ FilePath
err