{-# LANGUAGE DeriveAnyClass #-}
{-# LANGUAGE LambdaCase #-}
{-# LANGUAGE OverloadedStrings #-}
{-# LANGUAGE RecordWildCards #-}
{-# LANGUAGE NoImplicitPrelude #-}

module Biz.Namespace
  ( Namespace (..),
    Ext (..),
    fromPath,
    toPath,
    fromHaskellContent,
    fromHaskellModule,
    toHaskellModule,
    toSchemeModule,
    isCab,
  )
where

import Alpha
import qualified Data.Aeson as Aeson
import qualified Data.Char as Char
import qualified Data.List as List
import qualified Data.List.Split as List
import qualified Text.Regex.Applicative as Regex

data Ext
  = C
  | Css
  | Hs
  | Json
  | Keys
  | Lisp
  | Md
  | Nix
  | None
  | Py
  | Rs
  | Scm
  | Sh
  deriving (Eq, Show, Generic, Aeson.ToJSON, Ord)

data Namespace = Namespace {path :: [String], ext :: Ext}
  deriving (Eq, Show, Generic, Aeson.ToJSON, Ord)

fromPath :: String -> String -> Maybe Namespace
fromPath bizRoot absPath =
  List.stripPrefix bizRoot absPath
    +> List.stripPrefix "/"
    +> Regex.match (Namespace </ rePath <* dot <*> reExt)

toPath :: Namespace -> FilePath
toPath (Namespace parts ext) =
  joinWith "/" parts <> toExt ext

toExt :: Ext -> String
toExt =
  ("." <>) <. \case
    C -> "c"
    Css -> "css"
    Hs -> "hs"
    Json -> "json"
    Keys -> "pub"
    Lisp -> "lisp"
    Md -> "md"
    Nix -> "nix"
    None -> "none"
    Py -> "py"
    Rs -> "rs"
    Scm -> "scm"
    Sh -> "sh"

fromHaskellContent :: String -> Maybe Namespace
fromHaskellContent c = case Regex.findFirstInfix haskellModule c of
  Nothing -> Nothing
  Just (_, Namespace {..}, _) -> Just <| Namespace (filter (/= ".") path) ext
  where
    haskellModule =
      Namespace
        </ (Regex.string "\nmodule " *> Regex.many (name <|> dot))
        <*> pure Hs

toHaskellModule :: Namespace -> String
toHaskellModule (Namespace parts Hs) = joinWith "." parts
toHaskellModule (Namespace {..}) =
  panic <| "can't convert " <> show ext <> " to a Haskell module"

fromHaskellModule :: String -> Namespace
fromHaskellModule s = Namespace (List.splitOn "." s) Hs

toSchemeModule :: Namespace -> String
toSchemeModule (Namespace parts Scm) = "(" ++ joinWith " " parts ++ ")"
toSchemeModule (Namespace {..}) =
  panic <| "can't convert " <> show ext <> " to a Scheme module"

dot :: Regex.RE Char String
dot = Regex.some <| Regex.sym '.'

name :: Regex.RE Char String
name =
  Regex.many (Regex.psym Char.isUpper)
    <> Regex.many (Regex.psym Char.isAlphaNum)

rePath :: Regex.RE Char [String]
rePath = Regex.many (name <* Regex.string "/" <|> name)

reExt :: Regex.RE Char Ext
reExt =
  C <$ Regex.string "c"
    <|> Css <$ Regex.string "css"
    <|> Hs <$ Regex.string "hs"
    <|> Json <$ Regex.string "json"
    <|> Keys <$ Regex.string "pub"
    <|> Lisp <$ Regex.string "lisp"
    <|> Md <$ Regex.string "md"
    <|> Nix <$ Regex.string "nix"
    <|> Py <$ Regex.string "py"
    <|> Rs <$ Regex.string "rs"
    <|> Scm <$ Regex.string "scm"
    <|> Sh <$ Regex.string "sh"

-- | The cab dir is for temporary files and build outputs, not for source
-- inputs.
isCab :: FilePath -> Bool
isCab ('_' : _) = True
isCab fp = "_" `List.isInfixOf` fp