git.iko.soy/rowtype-yoga/purescript-native
on 342c17f help sign in
rowtype-yoga/purescript-native/src/Language/PureScript/Names.hs
108 lines 3.1 kB history raw
1{-# LANGUAGE DeriveDataTypeable #-}
2{-# LANGUAGE DeriveFunctor #-}
3{-# LANGUAGE TemplateHaskell #-}
4{-# LANGUAGE GADTs #-}
6-- |
7-- Data types for names
8--
9module Language.PureScript.Names where
11import Control.Monad (liftM)
12import Control.Monad.Supply.Class
14import Data.List
15import Data.Data
16import Data.Aeson.TH
18-- |
19-- Names for value identifiers
20--
21data Ident
22 -- |
23 -- An alphanumeric identifier
24 --
25 = Ident String
26 -- |
27 -- A symbolic name for an infix operator
28 --
29 | Op String
30 -- |
31 -- A generated name for an identifier
32 --
33 | GenIdent (Maybe String) Integer deriving (Show, Read, Eq, Ord, Data, Typeable)
35runIdent :: Ident -> String
36runIdent (Ident i) = i
37runIdent (Op op) = op
38runIdent (GenIdent Nothing n) = "$" ++ show n
39runIdent (GenIdent (Just name) n) = "$" ++ name ++ show n
41showIdent :: Ident -> String
42showIdent (Op op) = '(' : op ++ ")"
43showIdent i = runIdent i
45freshIdent :: (MonadSupply m) => String -> m Ident
46freshIdent name = liftM (GenIdent (Just name)) fresh
48freshIdent' :: (MonadSupply m) => m Ident
49freshIdent' = liftM (GenIdent Nothing) fresh
51-- |
52-- Proper names, i.e. capitalized names for e.g. module names, type//data constructors.
53--
54newtype ProperName = ProperName { runProperName :: String } deriving (Show, Read, Eq, Ord, Data, Typeable)
56-- |
57-- Module names
58--
59newtype ModuleName = ModuleName [ProperName] deriving (Show, Read, Eq, Ord, Data, Typeable)
61runModuleName :: ModuleName -> String
62runModuleName (ModuleName pns) = intercalate "." (runProperName `map` pns)
64moduleNameFromString :: String -> ModuleName
65moduleNameFromString = ModuleName . splitProperNames
66 where
67 splitProperNames s = case dropWhile (== '.') s of
68 "" -> []
69 s' -> ProperName w : splitProperNames s''
70 where (w, s'') = break (== '.') s'
72-- |
73-- A qualified name, i.e. a name with an optional module name
74--
75data Qualified a = Qualified (Maybe ModuleName) a deriving (Show, Read, Eq, Ord, Data, Typeable, Functor)
77showQualified :: (a -> String) -> Qualified a -> String
78showQualified f (Qualified Nothing a) = f a
79showQualified f (Qualified (Just name) a) = runModuleName name ++ "." ++ f a
81-- |
82-- Provide a default module name, if a name is unqualified
83--
84qualify :: ModuleName -> Qualified a -> (ModuleName, a)
85qualify m (Qualified Nothing a) = (m, a)
86qualify _ (Qualified (Just m) a) = (m, a)
88-- |
89-- Makes a qualified value from a name and module name.
90--
91mkQualified :: a -> ModuleName -> Qualified a
92mkQualified name mn = Qualified (Just mn) name
94-- | Remove the module name from a qualified name
95disqualify :: Qualified a -> a
96disqualify (Qualified _ a) = a
98-- |
99-- Checks whether a qualified value is actually qualified with a module reference
100--
101isUnqualified :: Qualified a -> Bool
102isUnqualified (Qualified Nothing _) = True
103isUnqualified _ = False
105$(deriveJSON (defaultOptions { sumEncoding = ObjectWithSingleField }) ''Qualified)
106$(deriveJSON (defaultOptions { sumEncoding = ObjectWithSingleField }) ''Ident)
107$(deriveJSON (defaultOptions { sumEncoding = ObjectWithSingleField }) ''ProperName)
108$(deriveJSON (defaultOptions { sumEncoding = ObjectWithSingleField }) ''ModuleName)