module PathTree
  ( PathTree (..),
    buildPathTree,
  )
where

import qualified Convex.Action.Parser as Action
import Data.List.Split (splitOn)
import qualified Data.Map.Strict as Map

data PathTree = FuncNode Action.ConvexFunction | DirNode (Map.Map String PathTree) deriving (Int -> PathTree -> ShowS
[PathTree] -> ShowS
PathTree -> String
(Int -> PathTree -> ShowS)
-> (PathTree -> String) -> ([PathTree] -> ShowS) -> Show PathTree
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
$cshowsPrec :: Int -> PathTree -> ShowS
showsPrec :: Int -> PathTree -> ShowS
$cshow :: PathTree -> String
show :: PathTree -> String
$cshowList :: [PathTree] -> ShowS
showList :: [PathTree] -> ShowS
Show)

buildPathTree :: [Action.ConvexFunction] -> PathTree
buildPathTree :: [ConvexFunction] -> PathTree
buildPathTree = (PathTree -> ConvexFunction -> PathTree)
-> PathTree -> [ConvexFunction] -> PathTree
forall b a. (b -> a -> b) -> b -> [a] -> b
forall (t :: * -> *) b a.
Foldable t =>
(b -> a -> b) -> b -> t a -> b
foldl ((ConvexFunction -> PathTree -> PathTree)
-> PathTree -> ConvexFunction -> PathTree
forall a b c. (a -> b -> c) -> b -> a -> c
flip ConvexFunction -> PathTree -> PathTree
insertFunc) (Map String PathTree -> PathTree
DirNode Map String PathTree
forall k a. Map k a
Map.empty)
  where
    insertFunc :: Action.ConvexFunction -> PathTree -> PathTree
    insertFunc :: ConvexFunction -> PathTree -> PathTree
insertFunc ConvexFunction
func (DirNode Map String PathTree
dir) = Map String PathTree -> PathTree
DirNode ([String]
-> ConvexFunction -> Map String PathTree -> Map String PathTree
go (String -> String -> [String]
forall a. Eq a => [a] -> [a] -> [[a]]
splitOn String
"/" (ConvexFunction -> String
Action.funcPath ConvexFunction
func)) ConvexFunction
func Map String PathTree
dir)
    insertFunc ConvexFunction
_ PathTree
node = PathTree
node

    go :: [String] -> Action.ConvexFunction -> Map.Map String PathTree -> Map.Map String PathTree
    go :: [String]
-> ConvexFunction -> Map String PathTree -> Map String PathTree
go [] ConvexFunction
func Map String PathTree
dir = String -> PathTree -> Map String PathTree -> Map String PathTree
forall k a. Ord k => k -> a -> Map k a -> Map k a
Map.insert (ConvexFunction -> String
Action.funcName ConvexFunction
func) (ConvexFunction -> PathTree
FuncNode ConvexFunction
func) Map String PathTree
dir
    go (String
p : [String]
ps) ConvexFunction
func Map String PathTree
dir =
      let subTree :: PathTree
subTree = PathTree -> String -> Map String PathTree -> PathTree
forall k a. Ord k => a -> k -> Map k a -> a
Map.findWithDefault (Map String PathTree -> PathTree
DirNode Map String PathTree
forall k a. Map k a
Map.empty) String
p Map String PathTree
dir
          newSubTree :: PathTree
newSubTree = case PathTree
subTree of
            DirNode Map String PathTree
subDirMap -> Map String PathTree -> PathTree
DirNode ([String]
-> ConvexFunction -> Map String PathTree -> Map String PathTree
go [String]
ps ConvexFunction
func Map String PathTree
subDirMap)
            FuncNode ConvexFunction
_ -> String -> PathTree
forall a. HasCallStack => String -> a
error (String -> PathTree) -> String -> PathTree
forall a b. (a -> b) -> a -> b
$ String
"Path conflict: cannot create submodule in path containing function: " String -> ShowS
forall a. [a] -> [a] -> [a]
++ String
p
       in String -> PathTree -> Map String PathTree -> Map String PathTree
forall k a. Ord k => k -> a -> Map k a -> Map k a
Map.insert String
p PathTree
newSubTree Map String PathTree
dir