{- |
     Author  : Kai-Oliver Prott
     Version : May 2025

     Some useful operations on all kinds of data structures that
     are needed in `CurryDoc`.
-}
module CurryDoc.Info.Goodies where

import AbstractCurry.Types
import AbstractCurry.Select

import Curry.Types
import Curry.Ident

import Data.List ( intercalate )
import Data.Char ( isSpace, toLower )

-- | Transforms identifier to `QName` with empty module qualifier.
identToQName :: Ident ->  QName
identToQName (Ident _ s _) = ("", s)

-- | Transforms qualified identifier to `QName`.
qIdentToQName :: QualIdent -> QName
qIdentToQName (QualIdent _ Nothing   idt) = identToQName idt
qIdentToQName (QualIdent _ (Just mi) idt) = (mIdentToMName mi, n)
  where (_, n) = identToQName idt

-- | Transforms module identifier to `MName`.
mIdentToMName :: ModuleIdent -> MName
mIdentToMName (ModuleIdent _ ms) = intercalate "." ms

-- | Relaxed equality on QNames.
--   Only compares qualifier if present in both arguments.
(=~=) :: QName -> QName -> Bool
(   ""   , x) =~= (   ""   , y) = x == y
(   ""   , x) =~= (   (_:_), y) = x == y
(   (_:_), x) =~= (   ""   , y) = x == y
(xs@(_:_), x) =~= (ys@(_:_), y) = (xs, x) == (ys, y)

-- | Trans from AST-TypeExpr to FlatCurry/AbstractCurry TypeExpr.
typeExprToCType :: TypeExpr -> CTypeExpr
typeExprToCType (ParenType       _ t1   ) = typeExprToCType t1
typeExprToCType (VariableType    _ n    ) = CTVar (tvIName n)
typeExprToCType (ApplyType       _ t1 t2) =
  CTApply (typeExprToCType t1) (typeExprToCType t2)
typeExprToCType (ArrowType       _ t1 t2) =
  CFuncType (typeExprToCType t1) (typeExprToCType t2)
typeExprToCType (ConstructorType _ qid  ) = CTCons (qIdentToQName qid)
typeExprToCType (ListType        _ t1   ) =
  CTApply (CTCons ("", "[]")) (typeExprToCType t1)
typeExprToCType (TupleType       _ tys  ) =
  foldl (\b a -> CTApply b (typeExprToCType a))
        (CTCons ("", "(" ++ replicate (length tys - 1) ',' ++ ")")) tys
typeExprToCType (ForallType      _ _ t  ) = typeExprToCType t

-- | Transforms an identifier to the name of a type variable.
tvIName :: Ident -> CTVarIName
tvIName n = (0, idName n)

-- | Relaxed equality on `CTypeExpr`.
(=~~=) :: CTypeExpr -> CTypeExpr -> Bool
a =~~= b = case (a,b) of
  (CTVar (_, n1), CTVar (_, n2)) -> n1 == n2
  _                              -> a  == b

-- | Trans from AST-context to FlatCurry/AbstractCurry context.
contextToCContext :: Context -> CContext
contextToCContext cs = CContext (map constraintToCConstraint cs)

-- | Trans from AST-constraint to FlatCurry/AbstractCurry constraint.
constraintToCConstraint :: Constraint -> CConstraint
constraintToCConstraint (Constraint _ qid ts) =
  (qIdentToQName qid, map typeExprToCType ts)

-- | Returns all imports of a module.
getImports :: Module a -> [ImportDecl]
getImports (Module _ _ _ _ _ im _) = im

-- | Returns the `QName` of a constructor.
getConstrName   :: ConstrDecl -> QName
getConstrName (ConstrDecl _   idt _) = identToQName idt
getConstrName (ConOpDecl  _ _ idt _) = identToQName idt
getConstrName (RecordDecl _   idt _) = identToQName idt

-- | Returns the `QName` of a newtype constructor.
getNewtypeConstrName :: NewConstrDecl -> QName
getNewtypeConstrName (NewConstrDecl _ idt _) = identToQName idt
getNewtypeConstrName (NewRecordDecl _ idt _) = identToQName idt

-- | Returns the type of a field in FlatCurry/AbstractCurry.
cFieldType :: CFieldDecl -> CTypeExpr
cFieldType (CField _ _ ty) = ty

-- | Returns the type of a field.
fieldType :: FieldDecl -> CTypeExpr
fieldType (FieldDecl _ _ ty) = typeExprToCType ty

isPublicField :: CFieldDecl -> Bool
isPublicField (CField _ Public  _ ) = True
isPublicField (CField _ Private _ ) = False

-- | Returns the `QName`s of all public fields.
publicFieldNames :: CurryProg -> [QName]
publicFieldNames = concatMap publicFieldNames' . constructors
  where publicFieldNames' (CCons    _ _ _ ) = []
        publicFieldNames' (CRecord  _ _ fs) =
          map (\(CField n _ _) -> n) $ filter isPublicField fs

-- | Returns the `QName`s of all public classes.
publicClassNames :: CurryProg -> [QName]
publicClassNames (CurryProg _ _ _ cls _ _ _ _) =
  map publicClassName cls
  where publicClassName (CClass n _ _ _ _ _) = n

-- | Returns true iff the given type expression is a type application.
isApplyType :: CTypeExpr -> Bool
isApplyType t = case t of
  CTApply _ _ -> True
  _           -> False

-- | Returns true iff the given type expression is a function type.
isFunctionType :: CTypeExpr -> Bool
isFunctionType t = case t of
  CFuncType _ _ -> True
  _             -> False

-- | Combines multiple comment strings to a single string.
concatCommentStrings :: [String] -> String
concatCommentStrings = unlines

-- | Trims leading and trailing whitespace.
trimSpace :: String -> String
trimSpace = reverse . dropWhile isSpace . reverse . dropWhile isSpace

-- | Drops the first n tokens from a string.
--   Does not retain the whitespace between tokens.
dropTokens :: Int -> String -> String
dropTokens n = unwords . drop n . words

-- | Converts a string to lowercase.
toLowerString :: String -> String
toLowerString = map toLower

-- | Merges a list of strings into a single string.
mergeLines :: [String] -> String
mergeLines = intercalate "\n"

-- | Counts the preceding spaces in a string.
countIndent :: String -> Int
countIndent = length . takeWhile isSpace

-- | Drops all preceding whitespace characters from a string.
dropSpaces :: String -> String
dropSpaces = dropWhile (==' ')

-- | Conditional failure of a monadic computation.
guard :: Bool -> Maybe ()
guard True  = Just ()
guard False = Nothing

-- | Appends an element to the end of a list.
snoc :: [a] -> a -> [a]
snoc xs x = xs ++ [x]

-- | Checks if a comment is empty (not visible and
-- | not meaningful content, i.e., contains only whitespace).
isEmptyComment :: String -> Bool
isEmptyComment = all isSpace