ModuleName.hs

{-# LANGUAGE DeriveGeneric #-}
{-# LANGUAGE OverloadedStrings #-}
{-# LANGUAGE TupleSections #-}
{-# LANGUAGE FlexibleInstances #-}
-- | Valid Haskell qualified module names.
module FP.API.ModuleName
  ( ModuleName(..)
  , toModulePath
  , mainModule
  , checkModuleName
  , fromModuleName
  , isModulePath
  , fromModulePath
  ) where

import           Prelude
import           Control.Monad (mplus, guard)
import qualified Data.Char as Char (isAlphaNum, isUpper)
import           Data.Maybe (isJust)
import           Data.Text (Text)
import           Data.Text (splitOn)
import qualified Data.Text as T
import           Data.Monoid ((<>))
import           FP.API.Types

toModulePath :: ModuleName -> Text
toModulePath (ModuleName n) = T.intercalate "/" (splitOn "." n) <> ".hs"

mainModule :: ModuleName
mainModule = ModuleName "Main"

checkModuleName :: ModuleName -> Either Text ModuleName
checkModuleName (ModuleName mn) = maybe (Left ("Invalid module name: " <> mn)) Right $ fromModuleName mn

-- | Parses normal modules, or main modules with an additional filepath.
fromModuleName :: Text -> Maybe ModuleName
fromModuleName string
    | all validModuleComponent components && not (null components) = Just $ ModuleName string
    | otherwise                                                    = Nothing
  where
    components = splitOn "." string

-- | Determine if the given textual @FilePath@ might be a valid module path.
isModulePath :: Text -> Bool
isModulePath t = isJust $ T.stripSuffix ".hs" t `mplus` T.stripSuffix ".lhs" t

-- | Guesses a module name from a path, assuming that it ends in ".hs", and
--   every path component is a component of the name.  Should be the inverse
--   of 'toModulePath' (other than the 'Just').
fromModulePath :: Text -> Maybe ModuleName
fromModulePath s1 = do
    s2 <- T.stripSuffix ".hs" s1
    let components = splitOn "/" s2
    guard $ all validModuleComponent components
    guard $ not (null components)
    return $ ModuleName $ T.intercalate "." components

validModuleChar :: Char -> Bool
validModuleChar c = Char.isAlphaNum c || c == '_' || c == '\''

validModuleComponent :: Text -> Bool
validModuleComponent t =
    case T.uncons t of
        Nothing -> False
        Just (c, t') -> Char.isUpper c && T.all validModuleChar t'