module Development.Shake.Futhark ( getFutDeps
                                 , getAllFutDeps
                                 , needFut
                                 ) where

import           Control.Monad             ((<=<))
import           Data.Containers.ListUtils (nubOrd)
import           Data.Foldable             (traverse_)
import qualified Data.Text                 as T
import qualified Data.Text.IO              as TIO
import           Development.Shake         (Action, need, traced)
import           Language.Futhark.Parser   (SyntaxError (..), parseFuthark)
import           Language.Futhark.Syntax   (DecBase (..), ModBindBase (ModBind), ModExpBase (..), ProgBase (Prog), locStr)
import           System.Directory          (canonicalizePath, makeRelativeToCurrentDirectory)
import           System.FilePath           (takeDirectory, (<.>), (</>))

-- | @'need'@ a file and all its dependencies
needFut :: [FilePath] -> Action ()
needFut :: [FilePath] -> Action ()
needFut [FilePath]
fps = do
    [[FilePath]]
next <- FilePath -> IO [[FilePath]] -> Action [[FilePath]]
forall a. FilePath -> IO a -> Action a
traced FilePath
"getFutDeps" (IO [[FilePath]] -> Action [[FilePath]])
-> IO [[FilePath]] -> Action [[FilePath]]
forall a b. (a -> b) -> a -> b
$ (FilePath -> IO [FilePath]) -> [FilePath] -> IO [[FilePath]]
forall (t :: * -> *) (f :: * -> *) a b.
(Traversable t, Applicative f) =>
(a -> f b) -> t a -> f (t b)
forall (f :: * -> *) a b.
Applicative f =>
(a -> f b) -> [a] -> f [b]
traverse FilePath -> IO [FilePath]
getFutDeps [FilePath]
fps
    Partial => [FilePath] -> Action ()
[FilePath] -> Action ()
need ([[FilePath]] -> [FilePath]
forall (t :: * -> *) a. Foldable t => t [a] -> [a]
concat [[FilePath]]
next)
    ([FilePath] -> Action ()) -> [[FilePath]] -> Action ()
forall (t :: * -> *) (f :: * -> *) a b.
(Foldable t, Applicative f) =>
(a -> f b) -> t a -> f ()
traverse_ [FilePath] -> Action ()
needFut [[FilePath]]
next

getFutDeps :: FilePath -> IO [FilePath]
getFutDeps :: FilePath -> IO [FilePath]
getFutDeps FilePath
fp = (FilePath -> IO FilePath) -> [FilePath] -> IO [FilePath]
forall (t :: * -> *) (f :: * -> *) a b.
(Traversable t, Applicative f) =>
(a -> f b) -> t a -> f (t b)
forall (f :: * -> *) a b.
Applicative f =>
(a -> f b) -> [a] -> f [b]
traverse FilePath -> IO FilePath
canonicalizeRelative ([FilePath] -> IO [FilePath]) -> IO [FilePath] -> IO [FilePath]
forall (m :: * -> *) a b. Monad m => (a -> m b) -> m a -> m b
=<< do
    Text
contents <- FilePath -> IO Text
TIO.readFile FilePath
fp
    let dirFile :: FilePath
dirFile = FilePath -> FilePath
takeDirectory FilePath
fp
        parsed :: UncheckedProg
parsed = (SyntaxError -> UncheckedProg)
-> (UncheckedProg -> UncheckedProg)
-> Either SyntaxError UncheckedProg
-> UncheckedProg
forall a c b. (a -> c) -> (b -> c) -> Either a b -> c
either (FilePath -> UncheckedProg
forall a. Partial => FilePath -> a
error(FilePath -> UncheckedProg)
-> (SyntaxError -> FilePath) -> SyntaxError -> UncheckedProg
forall b c a. (b -> c) -> (a -> b) -> a -> c
.SyntaxError -> FilePath
showErr) UncheckedProg -> UncheckedProg
forall a. a -> a
id (Either SyntaxError UncheckedProg -> UncheckedProg)
-> Either SyntaxError UncheckedProg -> UncheckedProg
forall a b. (a -> b) -> a -> b
$ FilePath -> Text -> Either SyntaxError UncheckedProg
parseFuthark FilePath
fp Text
contents
    [FilePath] -> IO [FilePath]
forall a. a -> IO a
forall (f :: * -> *) a. Applicative f => a -> f a
pure ((FilePath
dirFile FilePath -> FilePath -> FilePath
</>) (FilePath -> FilePath)
-> (FilePath -> FilePath) -> FilePath -> FilePath
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (FilePath -> FilePath -> FilePath
<.> FilePath
"fut") (FilePath -> FilePath) -> [FilePath] -> [FilePath]
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> UncheckedProg -> [FilePath]
forall (f :: * -> *) vn. ProgBase f vn -> [FilePath]
extractFromProgBase UncheckedProg
parsed)
    where showErr :: SyntaxError -> FilePath
showErr (SyntaxError Loc
l Text
str) = Loc -> FilePath
forall a. Located a => a -> FilePath
locStr Loc
l FilePath -> FilePath -> FilePath
forall a. [a] -> [a] -> [a]
++ FilePath
": " FilePath -> FilePath -> FilePath
forall a. [a] -> [a] -> [a]
++ Text -> FilePath
T.unpack Text
str

-- | Get all transitive dependencies
getAllFutDeps :: FilePath -> IO [FilePath]
getAllFutDeps :: FilePath -> IO [FilePath]
getAllFutDeps FilePath
fp = do
    [FilePath]
deps <- FilePath -> IO [FilePath]
getFutDeps FilePath
fp
    [[FilePath]]
level <- (FilePath -> IO [FilePath]) -> [FilePath] -> IO [[FilePath]]
forall (t :: * -> *) (f :: * -> *) a b.
(Traversable t, Applicative f) =>
(a -> f b) -> t a -> f (t b)
forall (f :: * -> *) a b.
Applicative f =>
(a -> f b) -> [a] -> f [b]
traverse FilePath -> IO [FilePath]
getAllFutDeps [FilePath]
deps
    let next :: [FilePath]
next = [FilePath] -> [FilePath]
forall a. Ord a => [a] -> [a]
nubOrd ([[FilePath]] -> [FilePath]
forall (t :: * -> *) a. Foldable t => t [a] -> [a]
concat ([FilePath]
deps [FilePath] -> [[FilePath]] -> [[FilePath]]
forall a. a -> [a] -> [a]
: [[FilePath]]
level))
    [FilePath] -> IO [FilePath]
forall a. a -> IO a
forall (f :: * -> *) a. Applicative f => a -> f a
pure ([FilePath] -> IO [FilePath]) -> [FilePath] -> IO [FilePath]
forall a b. (a -> b) -> a -> b
$ if [[FilePath]] -> Bool
forall a. [a] -> Bool
forall (t :: * -> *) a. Foldable t => t a -> Bool
null [[FilePath]]
level then [FilePath]
deps else [FilePath]
next

canonicalizeRelative :: FilePath -> IO FilePath
canonicalizeRelative :: FilePath -> IO FilePath
canonicalizeRelative = FilePath -> IO FilePath
makeRelativeToCurrentDirectory (FilePath -> IO FilePath)
-> (FilePath -> IO FilePath) -> FilePath -> IO FilePath
forall (m :: * -> *) b c a.
Monad m =>
(b -> m c) -> (a -> m b) -> a -> m c
<=< FilePath -> IO FilePath
canonicalizePath

extractFromProgBase :: ProgBase f vn -> [FilePath]
extractFromProgBase :: forall (f :: * -> *) vn. ProgBase f vn -> [FilePath]
extractFromProgBase (Prog Maybe DocComment
_ [DecBase f vn]
ds) = (DecBase f vn -> [FilePath]) -> [DecBase f vn] -> [FilePath]
forall (t :: * -> *) a b. Foldable t => (a -> [b]) -> t a -> [b]
concatMap DecBase f vn -> [FilePath]
forall (f :: * -> *) vn. DecBase f vn -> [FilePath]
extractFromDecBase [DecBase f vn]
ds

extractFromDecBase :: DecBase f vn -> [FilePath]
extractFromDecBase :: forall (f :: * -> *) vn. DecBase f vn -> [FilePath]
extractFromDecBase (ImportDec FilePath
fp f ImportName
_ SrcLoc
_)             = [FilePath
fp]
extractFromDecBase (LocalDec DecBase f vn
d SrcLoc
_)                 = DecBase f vn -> [FilePath]
forall (f :: * -> *) vn. DecBase f vn -> [FilePath]
extractFromDecBase DecBase f vn
d
extractFromDecBase (OpenDec ModExpBase f vn
d SrcLoc
_)                  = ModExpBase f vn -> [FilePath]
forall (f :: * -> *) vn. ModExpBase f vn -> [FilePath]
extractFromModExpBase ModExpBase f vn
d
extractFromDecBase (ModDec (ModBind vn
_ [ModParamBase f vn]
_ Maybe (ModTypeExpBase f vn, f (Map VName VName))
_ ModExpBase f vn
m Maybe DocComment
_ SrcLoc
_)) = ModExpBase f vn -> [FilePath]
forall (f :: * -> *) vn. ModExpBase f vn -> [FilePath]
extractFromModExpBase ModExpBase f vn
m
extractFromDecBase ValDec{}                       = []
extractFromDecBase TypeDec{}                      = []
extractFromDecBase ModTypeDec{}                   = []

extractFromModExpBase :: ModExpBase f vn -> [FilePath]
extractFromModExpBase :: forall (f :: * -> *) vn. ModExpBase f vn -> [FilePath]
extractFromModExpBase (ModParens ModExpBase f vn
m SrcLoc
_)       = ModExpBase f vn -> [FilePath]
forall (f :: * -> *) vn. ModExpBase f vn -> [FilePath]
extractFromModExpBase ModExpBase f vn
m
extractFromModExpBase (ModImport FilePath
fp f ImportName
_ SrcLoc
_)    = [FilePath
fp]
extractFromModExpBase (ModDecs [DecBase f vn]
ds SrcLoc
_)        = (DecBase f vn -> [FilePath]) -> [DecBase f vn] -> [FilePath]
forall (t :: * -> *) a b. Foldable t => (a -> [b]) -> t a -> [b]
concatMap DecBase f vn -> [FilePath]
forall (f :: * -> *) vn. DecBase f vn -> [FilePath]
extractFromDecBase [DecBase f vn]
ds
extractFromModExpBase (ModApply ModExpBase f vn
m ModExpBase f vn
m' f (Map VName VName)
_ f (Map VName VName)
_ SrcLoc
_) = (ModExpBase f vn -> [FilePath]) -> [ModExpBase f vn] -> [FilePath]
forall (t :: * -> *) a b. Foldable t => (a -> [b]) -> t a -> [b]
concatMap ModExpBase f vn -> [FilePath]
forall (f :: * -> *) vn. ModExpBase f vn -> [FilePath]
extractFromModExpBase [ModExpBase f vn
m, ModExpBase f vn
m']
extractFromModExpBase (ModAscript ModExpBase f vn
m ModTypeExpBase f vn
_ f (Map VName VName)
_ SrcLoc
_)  = ModExpBase f vn -> [FilePath]
forall (f :: * -> *) vn. ModExpBase f vn -> [FilePath]
extractFromModExpBase ModExpBase f vn
m
extractFromModExpBase (ModLambda ModParamBase f vn
_ Maybe (ModTypeExpBase f vn, f (Map VName VName))
_ ModExpBase f vn
m SrcLoc
_)   = ModExpBase f vn -> [FilePath]
forall (f :: * -> *) vn. ModExpBase f vn -> [FilePath]
extractFromModExpBase ModExpBase f vn
m
extractFromModExpBase ModVar{}              = []