module GF.Compile.Multi (readMulti) where
import Data.List
import Data.Char
readMulti :: FilePath -> IO (FilePath,[FilePath])
readMulti :: FilePath -> IO (FilePath, [FilePath])
readMulti FilePath
file = do
FilePath
src <- FilePath -> IO FilePath
readFile FilePath
file
let multi :: Multi
multi = FilePath -> FilePath -> Multi
getMulti ((Char -> Bool) -> FilePath -> FilePath
forall a. (a -> Bool) -> [a] -> [a]
takeWhile (Char -> Char -> Bool
forall a. Eq a => a -> a -> Bool
/=Char
'.') FilePath
file) FilePath
src
absn :: FilePath
absn = Multi -> FilePath
absName Multi
multi
cncns :: [FilePath]
cncns = Multi -> [FilePath]
cncNames Multi
multi
raws :: [(FilePath, FilePath)]
raws = Multi -> [(FilePath, FilePath)]
rawModules Multi
multi
FilePath -> FilePath -> IO ()
writeFile (FilePath -> FilePath
gfFile FilePath
absn) (Multi -> FilePath
absCode Multi
multi)
((FilePath, FilePath) -> IO ()) -> [(FilePath, FilePath)] -> IO ()
forall (t :: * -> *) (m :: * -> *) a b.
(Foldable t, Monad m) =>
(a -> m b) -> t a -> m ()
mapM_ ((FilePath -> FilePath -> IO ()) -> (FilePath, FilePath) -> IO ()
forall a b c. (a -> b -> c) -> (a, b) -> c
uncurry FilePath -> FilePath -> IO ()
writeFile)
[(FilePath -> FilePath
gfFile FilePath
cncn, FilePath -> FilePath -> [FilePath] -> FilePath
cncCode FilePath
absn FilePath
cncn [FilePath]
cod) |
FilePath
cncn <- Multi -> [FilePath]
cncNames Multi
multi, let cod :: [FilePath]
cod = [FilePath
r | (FilePath
la,FilePath
r) <- Multi -> [(FilePath, FilePath)]
cncRules Multi
multi, FilePath
la FilePath -> FilePath -> Bool
forall a. Eq a => a -> a -> Bool
== FilePath
cncn]]
FilePath -> IO ()
putStrLn (FilePath -> IO ()) -> FilePath -> IO ()
forall a b. (a -> b) -> a -> b
$ FilePath
"wrote " FilePath -> FilePath -> FilePath
forall a. [a] -> [a] -> [a]
++ [FilePath] -> FilePath
unwords ((FilePath -> FilePath) -> [FilePath] -> [FilePath]
forall a b. (a -> b) -> [a] -> [b]
map FilePath -> FilePath
gfFile (FilePath
absnFilePath -> [FilePath] -> [FilePath]
forall a. a -> [a] -> [a]
:[FilePath]
cncns))
((FilePath, FilePath) -> IO ()) -> [(FilePath, FilePath)] -> IO ()
forall (t :: * -> *) (m :: * -> *) a b.
(Foldable t, Monad m) =>
(a -> m b) -> t a -> m ()
mapM_ ((FilePath -> FilePath -> IO ()) -> (FilePath, FilePath) -> IO ()
forall a b c. (a -> b -> c) -> (a, b) -> c
uncurry FilePath -> FilePath -> IO ()
writeFile) [(FilePath -> FilePath
gfFile FilePath
n,FilePath
s) | (FilePath
n,FilePath
s) <- [(FilePath, FilePath)]
raws]
(FilePath, [FilePath]) -> IO (FilePath, [FilePath])
forall (m :: * -> *) a. Monad m => a -> m a
return (FilePath -> FilePath
gfFile FilePath
absn, (FilePath -> FilePath) -> [FilePath] -> [FilePath]
forall a b. (a -> b) -> [a] -> [b]
map FilePath -> FilePath
gfFile [FilePath]
cncns)
data Multi = Multi {
Multi -> [(FilePath, FilePath)]
rawModules :: [(String,String)],
Multi -> FilePath
absName :: String,
Multi -> [FilePath]
cncNames :: [String],
Multi -> FilePath
startCat :: String,
Multi -> [FilePath]
absRules :: [String],
Multi -> [(FilePath, FilePath)]
cncRules :: [(String,String)]
}
emptyMulti :: Multi
emptyMulti :: Multi
emptyMulti = Multi :: [(FilePath, FilePath)]
-> FilePath
-> [FilePath]
-> FilePath
-> [FilePath]
-> [(FilePath, FilePath)]
-> Multi
Multi {
rawModules :: [(FilePath, FilePath)]
rawModules = [],
absName :: FilePath
absName = FilePath
"Abs",
cncNames :: [FilePath]
cncNames = [],
startCat :: FilePath
startCat = FilePath
"S",
absRules :: [FilePath]
absRules = [],
cncRules :: [(FilePath, FilePath)]
cncRules = []
}
absCode :: Multi -> String
absCode :: Multi -> FilePath
absCode Multi
multi = [FilePath] -> FilePath
unlines ([FilePath] -> FilePath) -> [FilePath] -> FilePath
forall a b. (a -> b) -> a -> b
$ FilePath
header FilePath -> [FilePath] -> [FilePath]
forall a. a -> [a] -> [a]
: [FilePath]
start [FilePath] -> [FilePath] -> [FilePath]
forall a. [a] -> [a] -> [a]
++ ([FilePath] -> [FilePath]
forall a. [a] -> [a]
reverse (Multi -> [FilePath]
absRules Multi
multi)) [FilePath] -> [FilePath] -> [FilePath]
forall a. [a] -> [a] -> [a]
++ [FilePath
"}"] where
header :: FilePath
header = FilePath
"abstract " FilePath -> FilePath -> FilePath
forall a. [a] -> [a] -> [a]
++ Multi -> FilePath
absName Multi
multi FilePath -> FilePath -> FilePath
forall a. [a] -> [a] -> [a]
++ FilePath
" = {"
start :: [FilePath]
start = [FilePath
"flags startcat = " FilePath -> FilePath -> FilePath
forall a. [a] -> [a] -> [a]
++ FilePath
cat FilePath -> FilePath -> FilePath
forall a. [a] -> [a] -> [a]
++ FilePath
" ;", FilePath
"cat " FilePath -> FilePath -> FilePath
forall a. [a] -> [a] -> [a]
++ FilePath
cat FilePath -> FilePath -> FilePath
forall a. [a] -> [a] -> [a]
++ FilePath
" ;"]
cat :: FilePath
cat = Multi -> FilePath
startCat Multi
multi
cncCode :: String -> String -> [String] -> String
cncCode :: FilePath -> FilePath -> [FilePath] -> FilePath
cncCode FilePath
ab FilePath
cnc [FilePath]
rules = [FilePath] -> FilePath
unlines ([FilePath] -> FilePath) -> [FilePath] -> FilePath
forall a b. (a -> b) -> a -> b
$ FilePath
header FilePath -> [FilePath] -> [FilePath]
forall a. a -> [a] -> [a]
: ([FilePath] -> [FilePath]
forall a. [a] -> [a]
reverse [FilePath]
rules [FilePath] -> [FilePath] -> [FilePath]
forall a. [a] -> [a] -> [a]
++ [FilePath
"}"]) where
header :: FilePath
header = FilePath
"concrete " FilePath -> FilePath -> FilePath
forall a. [a] -> [a] -> [a]
++ FilePath
cnc FilePath -> FilePath -> FilePath
forall a. [a] -> [a] -> [a]
++ FilePath
" of " FilePath -> FilePath -> FilePath
forall a. [a] -> [a] -> [a]
++ FilePath
ab FilePath -> FilePath -> FilePath
forall a. [a] -> [a] -> [a]
++ FilePath
" = {"
getMulti :: String -> String -> Multi
getMulti :: FilePath -> FilePath -> Multi
getMulti FilePath
m FilePath
s = (Multi -> FilePath -> Multi) -> Multi -> [FilePath] -> Multi
forall (t :: * -> *) b a.
Foldable t =>
(b -> a -> b) -> b -> t a -> b
foldl ((FilePath -> Multi -> Multi) -> Multi -> FilePath -> Multi
forall a b c. (a -> b -> c) -> b -> a -> c
flip FilePath -> Multi -> Multi
addMulti) (Multi
emptyMulti{absName :: FilePath
absName = FilePath
m}) ([FilePath] -> [FilePath]
modlines (FilePath -> [FilePath]
lines FilePath
s))
addMulti :: String -> Multi -> Multi
addMulti :: FilePath -> Multi -> Multi
addMulti FilePath
line Multi
multi = case FilePath
line of
Char
'-':Char
'-':FilePath
_ -> Multi
multi
FilePath
_ | (Char -> Bool) -> FilePath -> Bool
forall (t :: * -> *) a. Foldable t => (a -> Bool) -> t a -> Bool
all Char -> Bool
isSpace FilePath
line -> Multi
multi
Char
'>':FilePath
s -> case FilePath -> [FilePath]
words FilePath
s of
FilePath
"langs":[FilePath]
ws -> let las :: [FilePath]
las = [Multi -> FilePath
absName Multi
multi FilePath -> FilePath -> FilePath
forall a. [a] -> [a] -> [a]
++ FilePath
w | FilePath
w <- [FilePath]
ws] in Multi
multi {
cncNames :: [FilePath]
cncNames = [FilePath]
las,
cncRules :: [(FilePath, FilePath)]
cncRules = [[(FilePath, FilePath)]] -> [(FilePath, FilePath)]
forall (t :: * -> *) a. Foldable t => t [a] -> [a]
concat [[(FilePath
la,FilePath
"lincat " FilePath -> FilePath -> FilePath
forall a. [a] -> [a] -> [a]
++ Multi -> FilePath
startCat Multi
multi FilePath -> FilePath -> FilePath
forall a. [a] -> [a] -> [a]
++ FilePath
" = Str ;"),
(FilePath
la,FilePath
"flags coding = utf8 ;")] | FilePath
la <- [FilePath]
las]
}
FilePath
"startcat":FilePath
c:[FilePath]
ws -> Multi
multi {startCat :: FilePath
startCat = FilePath
c}
FilePath
"abs":[FilePath]
ws -> Multi
multi {
absRules :: [FilePath]
absRules = [FilePath] -> FilePath
unwords [FilePath]
ws FilePath -> [FilePath] -> [FilePath]
forall a. a -> [a] -> [a]
: Multi -> [FilePath]
absRules Multi
multi
}
FilePath
langs:[FilePath]
ws -> Multi
multi {
cncRules :: [(FilePath, FilePath)]
cncRules = [(Multi -> FilePath
absName Multi
multi FilePath -> FilePath -> FilePath
forall a. [a] -> [a] -> [a]
++ FilePath
la, [FilePath] -> FilePath
unwords [FilePath]
ws) | FilePath
la <- Char -> FilePath -> [FilePath]
forall c. Eq c => c -> [c] -> [[c]]
chop Char
',' FilePath
langs] [(FilePath, FilePath)]
-> [(FilePath, FilePath)] -> [(FilePath, FilePath)]
forall a. [a] -> [a] -> [a]
++ Multi -> [(FilePath, FilePath)]
cncRules Multi
multi
}
FilePath
_ -> case FilePath -> [FilePath]
words FilePath
line of
FilePath
m:FilePath
name:[FilePath]
_ | FilePath -> Bool
isModule FilePath
m -> Multi
multi {
rawModules :: [(FilePath, FilePath)]
rawModules = (FilePath
name,FilePath
line)(FilePath, FilePath)
-> [(FilePath, FilePath)] -> [(FilePath, FilePath)]
forall a. a -> [a] -> [a]
:Multi -> [(FilePath, FilePath)]
rawModules Multi
multi
}
[FilePath]
_ -> let (FilePath
cat,FilePath
fun,[FilePath]
lins) = FilePath -> FilePath -> (FilePath, FilePath, [FilePath])
getRules (Multi -> FilePath
startCat Multi
multi) FilePath
line in
Multi
multi {
absRules :: [FilePath]
absRules = (FilePath
"fun " FilePath -> FilePath -> FilePath
forall a. [a] -> [a] -> [a]
++ FilePath
fun FilePath -> FilePath -> FilePath
forall a. [a] -> [a] -> [a]
++ FilePath
" : " FilePath -> FilePath -> FilePath
forall a. [a] -> [a] -> [a]
++ FilePath
cat FilePath -> FilePath -> FilePath
forall a. [a] -> [a] -> [a]
++ FilePath
" ;") FilePath -> [FilePath] -> [FilePath]
forall a. a -> [a] -> [a]
: Multi -> [FilePath]
absRules Multi
multi,
cncRules :: [(FilePath, FilePath)]
cncRules = [FilePath] -> [FilePath] -> [(FilePath, FilePath)]
forall a b. [a] -> [b] -> [(a, b)]
zip (Multi -> [FilePath]
cncNames Multi
multi) [FilePath]
lins [(FilePath, FilePath)]
-> [(FilePath, FilePath)] -> [(FilePath, FilePath)]
forall a. [a] -> [a] -> [a]
++ Multi -> [(FilePath, FilePath)]
cncRules Multi
multi
}
getRules :: String -> String -> (String,String,[String])
getRules :: FilePath -> FilePath -> (FilePath, FilePath, [FilePath])
getRules FilePath
cat FilePath
line = (FilePath
cat, FilePath
fun, ([FilePath] -> FilePath) -> [[FilePath]] -> [FilePath]
forall a b. (a -> b) -> [a] -> [b]
map [FilePath] -> FilePath
lin [[FilePath]]
rss) where
rss :: [[FilePath]]
rss = (FilePath -> [FilePath]) -> [FilePath] -> [[FilePath]]
forall a b. (a -> b) -> [a] -> [b]
map ((FilePath -> FilePath) -> [FilePath] -> [FilePath]
forall a b. (a -> b) -> [a] -> [b]
map FilePath -> FilePath
unspace ([FilePath] -> [FilePath])
-> (FilePath -> [FilePath]) -> FilePath -> [FilePath]
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Char -> FilePath -> [FilePath]
forall c. Eq c => c -> [c] -> [[c]]
chop Char
',') ([FilePath] -> [[FilePath]]) -> [FilePath] -> [[FilePath]]
forall a b. (a -> b) -> a -> b
$ Char -> FilePath -> [FilePath]
forall c. Eq c => c -> [c] -> [[c]]
chop Char
';' FilePath
line
fun :: FilePath
fun = (Char -> Char) -> FilePath -> FilePath
forall a b. (a -> b) -> [a] -> [b]
map Char -> Char
idChar ([FilePath] -> FilePath
forall a. [a] -> a
head ([[FilePath]] -> [FilePath]
forall a. [a] -> a
head [[FilePath]]
rss)) FilePath -> FilePath -> FilePath
forall a. [a] -> [a] -> [a]
++ FilePath
"_" FilePath -> FilePath -> FilePath
forall a. [a] -> [a] -> [a]
++ FilePath
cat
lin :: [FilePath] -> FilePath
lin [FilePath]
rs = FilePath
"lin " FilePath -> FilePath -> FilePath
forall a. [a] -> [a] -> [a]
++ FilePath
fun FilePath -> FilePath -> FilePath
forall a. [a] -> [a] -> [a]
++ FilePath
" = " FilePath -> FilePath -> FilePath
forall a. [a] -> [a] -> [a]
++ [FilePath] -> FilePath
unwords (FilePath -> [FilePath] -> [FilePath]
forall a. a -> [a] -> [a]
intersperse FilePath
"|" ((FilePath -> FilePath) -> [FilePath] -> [FilePath]
forall a b. (a -> b) -> [a] -> [b]
map FilePath -> FilePath
quote [FilePath]
rs)) FilePath -> FilePath -> FilePath
forall a. [a] -> [a] -> [a]
++ FilePath
" ;"
chop :: Eq c => c -> [c] -> [[c]]
chop :: c -> [c] -> [[c]]
chop c
c [c]
cs = case (c -> Bool) -> [c] -> ([c], [c])
forall a. (a -> Bool) -> [a] -> ([a], [a])
break (c -> c -> Bool
forall a. Eq a => a -> a -> Bool
==c
c) [c]
cs of
([c]
w,c
_:[c]
cs2) -> [c]
w [c] -> [[c]] -> [[c]]
forall a. a -> [a] -> [a]
: c -> [c] -> [[c]]
forall c. Eq c => c -> [c] -> [[c]]
chop c
c [c]
cs2
([],[]) -> []
([c]
w,[c]
_) -> [[c]
w]
unspace :: String -> String
unspace :: FilePath -> FilePath
unspace = [FilePath] -> FilePath
unwords ([FilePath] -> FilePath)
-> (FilePath -> [FilePath]) -> FilePath -> FilePath
forall b c a. (b -> c) -> (a -> b) -> a -> c
. FilePath -> [FilePath]
words
quote :: String -> String
quote :: FilePath -> FilePath
quote FilePath
r = FilePath
"\"" FilePath -> FilePath -> FilePath
forall a. [a] -> [a] -> [a]
++ FilePath
r FilePath -> FilePath -> FilePath
forall a. [a] -> [a] -> [a]
++ FilePath
"\""
idChar :: Char -> Char
idChar :: Char -> Char
idChar Char
c =
if (Int
n Int -> Int -> Bool
forall a. Ord a => a -> a -> Bool
> Int
47 Bool -> Bool -> Bool
&& Int
n Int -> Int -> Bool
forall a. Ord a => a -> a -> Bool
< Int
58) Bool -> Bool -> Bool
|| (Int
n Int -> Int -> Bool
forall a. Ord a => a -> a -> Bool
> Int
64 Bool -> Bool -> Bool
&& Int
n Int -> Int -> Bool
forall a. Ord a => a -> a -> Bool
< Int
91) Bool -> Bool -> Bool
|| (Int
n Int -> Int -> Bool
forall a. Ord a => a -> a -> Bool
> Int
96 Bool -> Bool -> Bool
&& Int
n Int -> Int -> Bool
forall a. Ord a => a -> a -> Bool
< Int
123)
then Char
c
else Char
'_'
where n :: Int
n = Char -> Int
forall a. Enum a => a -> Int
fromEnum Char
c
gfFile :: FilePath -> FilePath
gfFile :: FilePath -> FilePath
gfFile FilePath
f = FilePath
f FilePath -> FilePath -> FilePath
forall a. [a] -> [a] -> [a]
++ FilePath
".gf"
isModule :: String -> Bool
isModule :: FilePath -> Bool
isModule = (FilePath -> [FilePath] -> Bool) -> [FilePath] -> FilePath -> Bool
forall a b c. (a -> b -> c) -> b -> a -> c
flip FilePath -> [FilePath] -> Bool
forall (t :: * -> *) a. (Foldable t, Eq a) => a -> t a -> Bool
elem
[FilePath
"abstract",FilePath
"concrete",FilePath
"incomplete",FilePath
"instance",FilePath
"interface",FilePath
"resource"]
modlines :: [String] -> [String]
modlines :: [FilePath] -> [FilePath]
modlines [FilePath]
ss = case [FilePath]
ss of
FilePath
l:[FilePath]
ls -> case FilePath -> [FilePath]
words FilePath
l of
FilePath
w:[FilePath]
_ | FilePath -> Bool
isModule FilePath
w -> case (FilePath -> Bool) -> [FilePath] -> ([FilePath], [FilePath])
forall a. (a -> Bool) -> [a] -> ([a], [a])
break (FilePath -> Bool
isModule (FilePath -> Bool) -> (FilePath -> FilePath) -> FilePath -> Bool
forall b c a. (b -> c) -> (a -> b) -> a -> c
. [FilePath] -> FilePath
forall (t :: * -> *) a. Foldable t => t [a] -> [a]
concat ([FilePath] -> FilePath)
-> (FilePath -> [FilePath]) -> FilePath -> FilePath
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Int -> [FilePath] -> [FilePath]
forall a. Int -> [a] -> [a]
take Int
1 ([FilePath] -> [FilePath])
-> (FilePath -> [FilePath]) -> FilePath -> [FilePath]
forall b c a. (b -> c) -> (a -> b) -> a -> c
. FilePath -> [FilePath]
words) [FilePath]
ls of
([FilePath]
ms,[FilePath]
rest) -> [FilePath] -> FilePath
unlines (FilePath
lFilePath -> [FilePath] -> [FilePath]
forall a. a -> [a] -> [a]
:[FilePath]
ms) FilePath -> [FilePath] -> [FilePath]
forall a. a -> [a] -> [a]
: [FilePath] -> [FilePath]
modlines [FilePath]
rest
[FilePath]
_ -> FilePath
l FilePath -> [FilePath] -> [FilePath]
forall a. a -> [a] -> [a]
: [FilePath] -> [FilePath]
modlines [FilePath]
ls
[FilePath]
_ -> []